3.4k Aufrufe
Gefragt in Tabellenkalkulation von
Hallo!

Ich habe eine Frage zum Inport von div. Excel-Datein in eine andere Excel-Datei mithilfe eines Makros und hoffe, dass jemand mir damit behilflich sein kann.

Hintergrund: Ich kopiere regelmäßig die Inhalte von 24 Ecxel-Dateien und füge Sie in 24 Tabellenblätter einer separaten Excel-Datei ein, in der die Daten weiterverarbeitet werden. Die Rohdaten befinden sich alle in demselben Ordner und sind folgendermaßen benannt 'variabel_JJMMTT.xls'.
Kopiert und eingefügt werden sollen jeweils die Spalten A bis Z.

Wie erstelle ich ein solches Makro?

Vielen Dank!

Holger

6 Antworten

0 Punkte
Beantwortet von benjaminm Mitglied (631 Punkte)
Hallo Holger,
ich weiß nicht wie umfangreich deine Tabellen sind, hier mal ein kurzes einfaches Makro im MakroRecorder aufgezeichnet.

Sub Tabuebertrag()
'
' Tabuebertrag Makro
' Makro am 25.11.10 von muenzer aufgezeichnet
' für dieses Makro müssen Quell- und Zieldatei geöffnet sein!
' Und es wird immer das ganze Blatt übertragen, nicht nur die letzten Einträge!
'
' Tastenkombination: Strg+t
'
' In die Klammern die gewünschte Quelldatei eintragen
Windows("Quelle_JJMMTT.xls").Activate
' Hier das Tabellenblatt von dem aus übertragen werden soll
Sheets("Daten").Select
' nun Tabellenbereich auswählen
Range("A:Z").Select
Selection.Copy
' In die Klammern die gewünsche Zieldatei eintragen
Windows("Zieldatei.xls").Activate
' Angabe ab wo in der Zieldatei die daten geschrieben werden sollen
Range("A1").Select
ActiveSheet.Paste
End Sub

Kopiere dir ab Sub Tabellenuebertrag bis End Sub den Code, und füge ihn in das Visual Basic ein. Da ich jetzt nicht weiß welche Excelversion du hast, hier mal der Weg für 2007:
Gehe auf die Registerkarte Entwicklertools(ganz rechts)

[nicht gefunden? Dann gehe über die Office Schaltfläche unten auf Excel-Optionen, unter Häufig verwendet im ersten Block dritte Zeile nen Haken rein.]

Dann (falls du mehrere Exceldateien geöffnet hast)
- wähle deine Quelldatei aus
- klicke den fett gedruckten Namen der Datei an
- rechtsklick
- einfügen
- Modul...
und dort trägst du den kopieren Code ein fertig.

Gruß Benjamin
0 Punkte
Beantwortet von beverly Experte (3.5k Punkte)
Hi Holger,

soll nur ein Teil der Tabellenblätter übertragen werden oder die kompletten Tabellenblätter? Liegen die Quelldateien alle im selben Ordner wie die Zieldatei? Befinden sich noch andere Arbeitsmappen in dem Ordner?

Bis später,
Karin
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi all :-)

ein beispiel das die worksheets nach dem index anspricht

pfad sollte angepasst werden

gruss nighty


Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String
Dim WksIndex As Integer
DateiName = Dir("C:\Temp\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & DateiName
For WksIndex = 1 To 24
With Workbooks(DateiName).Worksheets(WksIndex)
.Range(.Cells(1, 1), .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, .UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Copy
ThisWorkbook.Worksheets(WksIndex).Range("A" & ThisWorkbook.Worksheets(WksIndex).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
Workbooks(DateiName).Close SaveChanges:=True
End With
Next WksIndex
End If
DateiName = Dir
Loop
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
0 Punkte
Beantwortet von
Guten Morgen @ all!

Vielen Dank für Eure Hilfe!

Ist es möglich, dass ich sowohl den Pfad als auch den Namen der zu importierenden Datei aus einem separaten Tabellenblatt innerhalb der Zieldatei vom Makro auslesen lasse?

Die Dateinamen der zu importierenden Dateien ändern sich ja wg. des Datums (variabel_JJMMTT.xls) täglich. So müsste ich die Anpassungen nur auf dem Tabellenblatt und nicht innerhalb des Makros vornehmen.

Workbooks.Open Filename:= _
"C:\Users\MM\Documents\Sonstiges\Testdaten\Testdaten1_101125.xls" ==> Pfad steht in Zelle B4 im Tabellenblatt 'Steuerung'
Columns("A:H").Select
Selection.Copy
Windows("Test.xls").Activate
Sheets("Testdaten1").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Windows("Testdaten1_101125.xls").Activate ==> Dateiname steht in Zelle B6 im Tabellenblatt 'Steuerung'
Application.CutCopyMode = False
Range("A1").Select
ActiveWindow.Close
Sheets("Auswertung").Select
Range("A1").Select

Danke und Gruß
Holger
0 Punkte
Beantwortet von coros Experte (4k Punkte)
Hallo Holger,

nachfolgend mal ein Makro, welches Dir eine Exceldatei, deren Pfad und Name in Zelle B4 steht, öffnet und die Spalten A:H kopiert und in die Ausgangsdatei einfügt.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Sub Daten_kopieren()
Dim wkbQuelle As Object

Set wkbQuelle = GetObject(Sheets("Tabelle1").Range("B4"))

wkbQuelle.Sheets("Tabelle1").Columns("A:H").Copy ThisWorkbook.Sheets("Testdaten1").Range("A1")

wkbQuelle.Close

Set wkbQuelle = Nothing
End Sub
Du musst in obigen Code allerdings noch einige Namen anpassen, da mir diese nicht bekannt waren.

In Zeile

Set wkbQuelle = GetObject(Sheets("Tabelle1").Range("B4"))muss der Blattname „Tabelle1“ gegen den Namen ausgetauscht werden, in dem bei Dir der Pfad in Zelle B4 steht.
Dann in der Zeile

wkbQuelle.Sheets("Tabelle1").Columns("A:H").Copy ThisWorkbook.Sheets("Testdaten1").Range("A1")muss wieder der Name “Tabelle1” gegen den Namen ausgetauscht werden, der den zu kopierenden Inhalt der zu öffnenden Datei der Spalten A:H hat.

Ansonsten sollte der Code funktionieren, z.B. bei mir funzt er.

Bei Fragen melde Dich.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]
0 Punkte
Beantwortet von
@ Oliver

Herzlichen Dank! Damit wäre mein Problem gelöst!

Gruß Holger
...