Índice
Para combinar pastas de trabalho no Excel, use o código a seguir. Este código pegará todas as primeiras planilhas em cada pasta de trabalho encontrada em um diretório:
| 123456789101112131415161718192021222324252627282930313233343536 | 'Merge WorkbooksSub MergeWBs ()Application.EnableEvents = FalseApplication.ScreenUpdating = FalseDim path As String, ThisWB As String, lngFilecounter As LongDim wbDest As Workbook, shtDest As Worksheet, ws As WorksheetDim Filename As String, Wkb As WorkbookDim CopyRng como intervalo, Dest como intervaloDim RowofCopySheet As IntegerRowofCopySheet = 2 'Linha para começar nas planilhas das quais você está copiandoThisWB = ActiveWorkbook.Namepath = GetDirectory ("Selecione uma pasta contendo os arquivos Excel que você deseja mesclar")Defina shtDest = ActiveWorkbook.Sheets (1)Nome do arquivo = Dir (caminho & "\ *. Xlsm", vbNormal)Se Len (nome do arquivo) = 0 então saia do SubDo Até Filename = vbNullStringIf Not Filename = ThisWB ThenDefinir Wkb = Workbooks.Open (Nome do arquivo: = caminho & "\" & Nome do arquivo)Defina CopyRng = Wkb.Sheets (1) .Range (Cells (RowofCopySheet, 1), Cells (ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))Defina Dest = shtDest.Range ("A" & shtDest.UsedRange.SpecialCells (xlCellTypeLastCell) .Row + 1)CopyRng.Copy DestWkb.Close FalseFim seNome do arquivo = Dir ()CicloApplication.EnableEvents = TrueApplication.ScreenUpdating = TrueMsgBox "Macro Completa"End Sub |
Sr. Excel
