Nachdem man mir hier heute schon so freundlich geholfen hat versuch ichs glatt noch mal.
Hey,
nun ist mein Problem, dass ich ca. 1000 gleich aufgebaute Excel-Dateien habe und nun jeweils die erste Spalte daraus in ein Sammeldokument kopieren möchte.
Haken an der Sache: Das Kopierte sollte jeweils 5 Spalten hinter dem zuletzt Eingefügten erscheinen - und das klappt nicht so ganz
Derzeitiges Skript:
Sub Aufmachen()
DieseDatei = ActiveWorkbook.Name
Set AlleDateien = Application.FileDialog(msoFileDialogOpen)
With AlleDateien
.AllowMultiSelect = True
If .Show = -1 Then
For Each Datei In .SelectedItems
y = 2
Set Dnam = Workbooks.Open(Datei)
Range("A2:A30").Copy
Windows(DieseDatei).Activate
Cells(6, y).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Dnam.Close False
y = y + 5
Next
End If
End With
End Sub
Somit kann ich gezielt die Dateien auswählen, aus denen die Spalten kopiert werden sollen. Allerdings werden die Spalten nun alle in B6 eingefügt ohne jeweils 5 Spalten weiter zu rücken.
Vielen Dank für die Hilfe
Hey,
nun ist mein Problem, dass ich ca. 1000 gleich aufgebaute Excel-Dateien habe und nun jeweils die erste Spalte daraus in ein Sammeldokument kopieren möchte.
Haken an der Sache: Das Kopierte sollte jeweils 5 Spalten hinter dem zuletzt Eingefügten erscheinen - und das klappt nicht so ganz
Derzeitiges Skript:
Sub Aufmachen()
DieseDatei = ActiveWorkbook.Name
Set AlleDateien = Application.FileDialog(msoFileDialogOpen)
With AlleDateien
.AllowMultiSelect = True
If .Show = -1 Then
For Each Datei In .SelectedItems
y = 2
Set Dnam = Workbooks.Open(Datei)
Range("A2:A30").Copy
Windows(DieseDatei).Activate
Cells(6, y).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Dnam.Close False
y = y + 5
Next
End If
End With
End Sub
Somit kann ich gezielt die Dateien auswählen, aus denen die Spalten kopiert werden sollen. Allerdings werden die Spalten nun alle in B6 eingefügt ohne jeweils 5 Spalten weiter zu rücken.
Vielen Dank für die Hilfe