简体   繁体   中英

copy non adjacent cells from subfolders excel files and paste row by row in master excel files found in parent folder

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM