"Tabelle1" aller Verzeichnismappen untereinander
19.09.2018 20:19:47
Toni
auf der Suche nach einem Code, der mir sämtliche Mappen eines Verzeichnisses öffnet und die jeweils aktiven Tabellen in die den Code ausführende Mappe in dass Blatt "Tabelle1" untereinander kopiert bin ich fündig geworden. Die Code-Mappe liegt im selben Verzeichnis wie die zu kopierenden Mappen. Der Code kommt von Beverly: auf "supportnet" entdeckt - ich sage mal Danke über drei Ecken :).
Jetzt wäre es schön, wenn mir nicht die gerade aktive Tabelle der geöffneten Mappen sondern nur die mit dem Namen "SoEinSpaß" kopiert werden.
Das wäre mir eine große Hilfe!
Sub zusammenfuegen()
Dim strDateiname As String
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Application.ScreenUpdating = False
strDateiname = Dir(ThisWorkbook.Path & "\*.xlsx")
With ThisWorkbook.Worksheets("Tabelle1")
Do While strDateiname ""
If strDateiname ThisWorkbook.Name Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strDateiname
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
loLetzte2 = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells( _
xlCellTypeLastCell).Row
inLetzte = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell) _
.Column
ActiveWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(loLetzte2, inLetzte)).Copy _
Destination:=.Cells(loLetzte1 + 1, 1)
ActiveWorkbook.Close True
End If
strDateiname = Dir
Loop
End With
Application.ScreenUpdating = True
End Sub
Anzeige