I got 4 subfolders containing excel files in .xlsm format. I need to copy data from same non-contiguous cells (A1, B5,C6) from all the excel files in subfolders. I got a parent folder in which stores my master workbook called.I want the data from each excel files(A1,B5,C6) be pasted in the master workbook sheet1 in a tabular form.
'Loop through the collection
For Each myItem In collSubFolders
'Loop through Excel workbooks in subfolder
myFile = Dir(myFolder & myItem & "\*.xlsm*")
Do While myFile <> “”
'Open workbook
Set wbk = Workbooks.Open(Filename:=myFolder & myItem & " \ " & myFile)
'Copy data from the opened workbook
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
ActiveSheet.Range("A1,B5,C6").Copy
'Close opened workbook without saving any changes
wbk.Close SaveChanges:=False
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
myFile = Dir
Loop
Next myItem
Application.ScreenUpdating = True
End Sub
The biggest problem is you are trying to copy a range of non-contiguous cells, which Excel doesn't allow. Also you are using activesheet, which you should be addressing the workbooks and sheets directly.
You weren't very precise in what you wanted or the name of your master file, so Here is what can be run to put A1, B5, C6 in the master file on sheet 1 in A1, A2, A3, then the same in column B for the next file, on through a separate column for each file you open. You will need to modify the Dir command for specific needs.
myfile = Dir(direct, "*.xlsm") 'sets myfile equal to the first file name
Do While myfile <> "" 'loops until there are no more files in the direstory
CLMS = Workbooks("Master_file.xlsx").Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column + 1
Set wbk = Workbooks.Open(FileName:=fname)
Workbooks(myfile).Sheets(1).Range("A1").Copy Workbooks("Master_file.xlsx").Sheets(1).Cells(1, CLMS)
Workbooks(myfile).Sheets(1).Range("B5").Copy Workbooks("Master_file.xlsx").Sheets(1).Cells(2, CLMS)
Workbooks(myfile).Sheets(1).Range("C6").Copy Workbooks("Master_file.xlsx").Sheets(1).Cells(3, CLMS)
wbk.Close SaveChanges:=False`
Workbooks("Master_file.xlsx").save
myfile = Dir
Loop
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.