Inhaltsverzeichnis
Verwenden Sie den folgenden Code, um Arbeitsmappen in Excel zu kombinieren. Dieser Code nimmt alle ersten Blätter in jeder Arbeitsmappe, die in einem Verzeichnis gefunden wird:
| 123456789101112131415161718192021222324252627282930313233343536 | 'Arbeitsmappen zusammenführenSub-MergeWBs()Application.EnableEvents = FalseApplication.ScreenUpdating = FalseDim path As String, ThisWB As String, lngFilecounter As LongDim wbDest als Arbeitsmappe, shtDest als Arbeitsblatt, ws als ArbeitsblattDim Dateiname als String, Wkb als ArbeitsmappeDim CopyRng als Bereich, Dest als BereichDim RowofCopySheet As IntegerRowofCopySheet = 2 ' Zeile zum Beginnen in den Blättern, von denen Sie kopierenThisWB = ActiveWorkbook.Namepath = GetDirectory("Wählen Sie einen Ordner mit Excel-Dateien aus, die Sie zusammenführen möchten")Setze shtDest = ActiveWorkbook.Sheets(1)Dateiname = Dir(Pfad & "\*.xlsm", vbNormal)Wenn Len(Dateiname) = 0, dann Exit SubDo bis Dateiname = vbNullStringWenn nicht Dateiname = ThisWB ThenSet Wkb = Workbooks.Open(Dateiname:=Pfad & "\" & Dateiname)Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)CopyRng.Copy DestWkb.Close FalseEnde WennDateiname = Dir()SchleifeApplication.EnableEvents = TrueApplication.ScreenUpdating = TrueMsgBox "Makro komplett"End Sub |
Herr Excel
