Copie uma coluna ou colunas de cada pasta de trabalho em uma pasta usando VBA no Microsoft Excel

Anonim
  • A macro copiará uma parte da primeira planilha de cada arquivo que está na pasta C: \ Data para a primeira planilha de sua pasta de trabalho.
  • A primeira macro faz uma cópia normal e a segunda macro copia os valores.

Lembre-se de que o Excel tem apenas 256 colunas

Sub CopyColumn () Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim cnum As Integer Dim i As Long Dim a As Integer Application.ScreenUpdating = False With Application.FileSearch .NewSearch .LookIn = "C: \ Data ".SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute ()> 0 Then Set basebook = ThisWorkbook cnum = 1 For i = 1 To .FoundFiles.Count Set mybook = Workbooks.Open (.FoundFiles (i)) Set sourceRange = mybook.Worksheets (1) .Columns ("A: B") a = sourceRange.Columns.Count Set destrange = basebook.Worksheets (1) .Cells (1, cnum) sourceRange.Copy destrange mybook.Close cnum = i * a + 1 Next i End If End With Application.ScreenUpdating = True End Sub Sub CopyColumnValues ​​() Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim cnum As Integer Dim i As Long Dim a As Integer Application.ScreenUpdating = False With Application.FileSearch .NewSearch .LookIn = "C: \ Data" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute ()> 0 Then Set basebook = ThisWorkbook cnum = 1 For i = 1 To .FoundFiles.Count Set mybook = Workbooks.Open (.FoundFiles (i)) Set sourceRange = mybook.Worksheets ( 1) .Columns ("A: B") a = sourceRange.Columns.Count Com sourceRange Defina destrange = basebook.Worksheets (1) .Columns (cnum). _ Resize (, .Columns.Count) End With destrange.Value = sourceRange.Value mybook.Close cnum = i * a + 1 Next i End If End With Application.ScreenUpdating = True End Sub