Copiare una o più colonne da ogni cartella di lavoro in una cartella utilizzando VBA in Microsoft Excel
-
La macro copierà una parte del primo foglio di lavoro di ogni file che si trova nella cartella C: \ Data nel primo foglio di lavoro della cartella di lavoro.
-
La prima macro esegue una copia normale e la seconda copia i valori.
Ricorda che Excel ha solo 256 colonne
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
With sourceRange
Set 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