Cuprins
Pentru a combina registrele de lucru în Excel utilizați următorul cod. Acest cod va prelua toate primele foi din fiecare registru de lucru găsit într-un director:
| 123456789101112131415161718192021222324252627282930313233343536 | „Îmbinați cărțile de lucruSub MergeWBs ()Application.EnableEvents = FalsApplication.ScreenUpdating = FalsAtenuați calea ca șir, acest WB ca șir, lngFilecounter cât mai lungDim wbDest As Workbook, shtDest As Worksheet, ws As WorksheetDim Filename As String, Wkb As WorkbookDim CopyRng As Range, Dest As RangeDim RowofCopySheet Ca întregRowofCopySheet = 2 'Rând pentru a începe în foile din care copiațiThisWB = ActiveWorkbook.Namecale = GetDirectory („Selectați un folder care conține fișiere Excel pe care doriți să le îmbinați”)Setați shtDest = ActiveWorkbook.Sheets (1)Numele fișierului = Dir (cale & "\ *. Xlsm", vbNormal)Dacă Len (Numele fișierului) = 0, apoi ieșiți din SubFaceți până la Filename = vbNullStringIf Not Filename = ThisWB AtunciSetați Wkb = Workbooks.Open (Filename: = cale & "\" & Filename)Setați 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.Închide FalseEnd IfNumele fișierului = Dir ()BuclăApplication.EnableEvents = AdevăratApplication.ScreenUpdating = AdevăratMsgBox „Macro Complete”Sfârșitul Sub |
Domnule Excel
