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

PinakiB

New Member
Joined
Mar 25, 2017
Messages
15
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.

VBA Code:
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
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
1,927
Office Version
  1. 365
Platform
  1. Windows
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.


VBA Code:
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

New Member
Joined
Mar 25, 2017
Messages
15
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

New Member
Joined
Mar 25, 2017
Messages
15
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
 

Forum statistics

Threads
1,148,158
Messages
5,745,108
Members
423,924
Latest member
Gazzat

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top