Spisie treści
Aby połączyć skoroszyty w programie Excel, użyj następującego kodu. Ten kod zajmie wszystkie pierwsze arkusze w każdym skoroszycie znalezionym w katalogu:
| 123456789101112131415161718192021222324252627282930313233343536 | „Połącz skoroszyty”Sub MergeWBs()Application.EnableEvents = FalseApplication.ScreenUpdating = FałszŚcieżka Dim As String, ThisWB As String, lngFilecounter As LongDim wbDest As Workbook, shtDest As Worksheet, ws As WorksheetDim Filename As String, Wkb As WorkbookDim CopyRng As Range, Dest As RangeDim RowofCopySheet jako liczba całkowitaRowofCopySheet = 2 ' Wiersz, od którego ma się zaczynać w arkuszach, z których kopiujeszThisWB = ActiveWorkbook.Namepath = GetDirectory("Wybierz folder zawierający pliki Excela, które chcesz scalić")Ustaw shtDest = ActiveWorkbook.Arkusze(1)Nazwa pliku = Dir(ścieżka i "\*.xlsm", vbNormal)Jeśli Len(Nazwa pliku) = 0 to wyjdź z SubWykonaj dopóki nazwa pliku = vbNullStringJeśli nie nazwa pliku = ThisWB ThenUstaw Wkb = Workbooks.Open(Filename:=ścieżka & "\" & Filename)Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))Ustaw Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)Kopiuj. Kopiuj miejsce doceloweWkb.Zamknij FałszZakończ, jeśliNazwa pliku = Dir()PętlaApplication.EnableEvents = PrawdaApplication.ScreenUpdating = PrawdaMsgBox "Makro ukończone"Napis końcowy |
Pan Excel
