Inhoudsopgave
Gebruik de volgende code om werkmappen in Excel te combineren. Deze code neemt alle eerste bladen in elke werkmap die in een map wordt gevonden:
| 123456789101112131415161718192021222324252627282930313233343536 | 'Werkmappen samenvoegen'Sub MergeWB's()Application.EnableEvents = FalseApplication.ScreenUpdating = FalseDim pad As String, ThisWB As String, lngFilecounter As LongDim wbDest As Workbook, shtDest As Worksheet, ws As WorksheetDim bestandsnaam als string, Wkb als werkmapDim CopyRng As Range, Dest As RangeDim RowofCopySheet As IntegerRowofCopySheet = 2 ' Rij om mee te beginnen in de bladen waarvan u kopieertThisWB = ActiveWorkbook.Namepath = GetDirectory ("Selecteer een map met Excel-bestanden die u wilt samenvoegen")Stel shtDest = ActiveWorkbook.Sheets(1) inBestandsnaam = Dir(pad & "\*.xlsm", vbNormal)Als Len (bestandsnaam) = 0, verlaat dan SubDoen tot bestandsnaam = vbNullStringIndien niet Bestandsnaam = ThisWB DanStel Wkb = Workbooks.Open in (Bestandsnaam:=pad & "\" & Bestandsnaam)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.KopieerbestemmingWkb.Sluiten FalseStop alsBestandsnaam = Dir()LusApplication.EnableEvents = TrueApplication.ScreenUpdating = TrueMsgBox "Macro compleet"Einde sub |
Mijnheer Excel
