Obsah
Chcete -li kombinovat sešity v aplikaci Excel, použijte následující kód. Tento kód převezme všechny první listy v každém sešitu nalezeném v adresáři:
| 123456789101112131415161718192021222324252627282930313233343536 | „Sloučit sešityDílčí sloučení WB ()Application.EnableEvents = FalseApplication.ScreenUpdating = FalseDim path As String, ThisWB As String, lngFilecounter As LongDim wbDest As Workbook, shtDest As Worksheet, ws As WorksheetDim Název souboru jako řetězec, Wkb jako sešitDim CopyRng As Range, Dest As RangeDim RowofCopySheet jako celé čísloRowofCopySheet = 2 'Řádek, od kterého začínáte v listech, ze kterých kopírujeteThisWB = ActiveWorkbook.Namepath = GetDirectory ("Vyberte složku obsahující soubory aplikace Excel, které chcete sloučit")Nastavit shtDest = ActiveWorkbook.Sheets (1)Název souboru = Dir (cesta & "\*. Xlsm", vbNormal)Pokud Len (název souboru) = 0, pak Exit SubDělejte, dokud Filename = vbNullStringPokud není název souboru = ThisWB ThenNastavit Wkb = Sešity. Otevřít (Název souboru: = cesta & "\" & Název souboru)Nastavit CopyRng = Wkb.Sheets (1) .Range (Cells (RowofCopySheet, 1), Cells (ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))Nastavit Dest = shtDest.Range ("A" & shtDest.UsedRange.SpecialCells (xlCellTypeLastCell) .Row + 1)CopyRng.Copy DestWkb.Close FalseKonec IfNázev souboru = Dir ()SmyčkaApplication.EnableEvents = TrueApplication.ScreenUpdating = TrueMsgBox „Makro dokončeno“End Sub |
Pane Exceli
