Open excel file and lop through all worksheets and copy a particular column's data and paste in a different workbook's worksheet

[PinakiB]

Hi All,

I am facing one challenge and need help regarding the excel vba. I have a macro (abc.xlsm) which will open an excel file (bca.xlsx) and on that excel file (bca.xlsx) so many worksheets are present. The macro has one sheet called "MDM" and when the macro will open the excel file (bca.xlsx), from that excel file (bca.xlsx) it will copy M column data from all sheets one by one and paste on the "MDM" sheet vertically. Here in my case the below code is not giving any error but it is not looping through all the worksheets and copy data. Please help me on this regard. Thank you.

Sub WAH()

Dim MyTargetFile As Variant
Dim MyAnotherSourceFile As Variant
Dim ws As Worksheet

MyTargetFile = "abc.xlsm"
MyAnotherSourceFile = Application.GetOpenFilename("Excel Files (*.xlsx),(*.xls), *xlsx,*.xls")
Workbooks.Open Filename:=MyAnotherSourceFile
SourceFileTempName = ActiveWorkbook.Name
For Each ws In Worksheets

 Range("M3").End(xlDown).Select 
Selection.Copy
Workbooks(MyTargetFile).Sheets("MDM").Activate
ActiveCell.PasteSpecial
ActiveCell.PasteSpecial
ActiveCell.Offset(1, 0).Select

    Next ws
End Sub

Regards,
Pinaki

 

[Jeffrey Mahoney]

Play round with this code. You may need to alter the output destination. I set it to column A and assumed you would add the data from the source to the end of the last copied data. The method I used only copies the values, not the source cell formatting. This is much faster.

Sub WAH()

  Dim MyTargetFile As Workbook
  Dim MyAnotherSourceFile As Variant
  Dim ws As Worksheet
  Dim MySourceFile As Workbook
  Dim R As Range
  Dim OutR As Range
  Dim Cel As Range
  Dim MDMSht As Worksheet
  
  Set MyTargetFile = ThisWorkbook             'Where this macro resides
  Set MDMSht = MyTargetFile.Worksheets("MDM") 'name of target sheet
  
  MyAnotherSourceFile = Application.GetOpenFilename("Excel Files (*.xlsx),(*.xls), *xlsx,*.xls") 'returns name of file with path
  If MyAnotherSourceFile = "" Then Exit Sub
  Set MySourceFile = Workbooks.Open(Filename:=MyAnotherSourceFile) 'Returns object
  
  
  For Each ws In MySourceFile.Worksheets
    Set R = ws.Range(ws.Range("M3"), ws.Range("m3").End(xlDown))              'Range from WS
    Set Cel = MDMSht.Cells(MDMSht.Cells.Rows.Count, 1).End(xlUp).Offset(1, 0) 'first blank cell in column a
    Set OutR = MDMSht.Range(Cel, Cel.Offset(R.Rows.Count - 1, 0))             'Range below all the rest of the data
    OutR.Value = R.Value
  Next ws
  
  MySourceFile.Close savechanges:=False   'Close source
  
End Sub

 

[PinakiB]

Hi Jeffrey,

Thank you for the code. I tested the code but I found one Run Time error '1004' in the below line of the code.

Set OutR = MDMSht.Range(Cel, Cel.Offset(R.Rows.Count - 1, 0))

Regards,
Pinaki

 

[PinakiB]

Hi Jeffrey,

Sorry it was my mistake. the error actual was for the wrong data input else the above code is absolutely running smoothly as per my requirement. Thank you so much for the code and appreciate your help.

Regards,
Pinaki

 

[Jeffrey Mahoney]

I'm glad it's working.