copy paste data from multiple workbook from multiple worksheets along with the file name in column A

[James Clear]

hi Guys,

I am stuck here.

Currently I am using below code : But I would like to get eacch files name into each sheet , How can i get file name alonvg with this code? pls assits

Dim erow As Long, lastrow As Long, lastcolumn As Long

For counter = 1 To 3
Workbooks.Open Filename:=”C:\mandar-test\mandar1.xlsx”
‘Sheets(“Sheet1”).Select
Worksheets(counter).Select
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
ActiveWorkbook.Close

Sheets(“Sheet1″).Select
Worksheets(counter).Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1).Select
ActiveSheet.Paste
Next

For counter = 1 To 3
Workbooks.Open Filename:=”C:\mandar-test\mandar2.xlsx”
‘Sheets(“Sheet1”).Select
Worksheets(counter).Select
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
ActiveWorkbook.Close

‘ Sheets(“Sheet1”).Select
Worksheets(counter).Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1).Select
ActiveSheet.Paste
Next
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1).Select
End Sub

 

[James Clear]

And did that work or not ?
If not please show the me the error message and which line is highlighted when you hit debug.
Also go into Excel > File > Open and paste in one of those addresses and see if it works if you do it manually.

 

[Alex Blakenburg]

And what about ?

If not please show the me the error message and which line is highlighted when you hit debug.
Also go into Excel > File > Open and paste in one of those addresses and see if it works if you do it manually.

In addition to those 2 items I need to see your equivalent of this line.

    For Each wbName In Array("C:\mandar-test\mandar1.xlsx", "C:\mandar-test\mandar2.xlsx")

 

[James Clear]

And what about ?

In addition to those 2 items I need to see your equivalent of this line.

    For Each wbName In Array("C:\mandar-test\mandar1.xlsx", "C:\mandar-test\mandar2.xlsx")

Ok so you want me to give each workbook’s name? Got it .. let me try n come back to you.

 

[Alex Blakenburg]

If it gets too long you can do something like this:

    For Each wbName In Array("C:\mandar-test\mandar1.xlsx", _
                                                                   "C:\mandar-test\mandar2.xlsx", _
                                                                   "C:\mandar-test\mandar3.xlsx")

Or define it as a variable.

 

[James Clear]

And did that work or not ?
If not please show the me the error message and which line is highlighted when you hit debug.
Also go into Excel > File > Open and paste in one of those addresses and see if it works if you do it manually.

Hi Alex, Its working perfectly fine , however there is an issue - Data is getting copied from 13 column?

I used - .Range(.Cells(5, 37), .Cells(lastrow, lastcolumn)).Copy

coz my data starts from 5th row and it has total 37 columns , however data is getting copied from 13th column? not sure why?
Pls help

 

[Alex Blakenburg]

Try changing the "1" in this line to the 5 or if the column headings are on row 4 to 4.

lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column

 

[James Clear]

See if this works for you.

Sub CopyAndAppend()

    Dim dest_erow As Long, dest_ecol As Long
    Dim lastrow As Long, lastcolumn As Long, counter As Long
    Dim srcWB As Workbook, destWB As Workbook
    Dim srcSht As Worksheet, destSht As Worksheet
    Dim wbName As Variant
    Dim srcWBName As String
   
    Application.ScreenUpdating = False
   
    Set destWB = ThisWorkbook

    For Each wbName In Array("C:\mandar-test\mandar1.xlsx", "C:\mandar-test\mandar2.xlsx")
        Set srcWB = Workbooks.Open(wbName)
        srcWBName = srcWB.Name
       
        For counter = 1 To 3
            Set srcSht = srcWB.Worksheets(counter)
            With srcSht
                lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
                lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
                .Range(.Cells(2, 1), .Cells(lastrow, lastcolumn)).Copy
            End With
           
            Set destSht = destWB.Worksheets(counter)
            With destSht
                dest_erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                dest_ecol = .Cells(1, .Columns.Count).End(xlToLeft).Column
                .Cells(dest_erow, 1).PasteSpecial Paste:=xlPasteAll
                .Range(.Cells(dest_erow, 1), .Cells(.Rows.Count, 1).End(xlUp)).Offset(0, dest_ecol) = srcWB.Name
            End With
            Application.CutCopyMode = False
        Next counter
        srcWB.Close
    Next wbName
   
    ' Reset cursor postion in each sheet
    For counter = 1 To 3
        Set destSht = destWB.Worksheets(counter)
        With destSht
            dest_erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            destSht.Activate
            .Cells(dest_erow, 1).Select
        End With
    Next counter
       
    Application.ScreenUpdating = True

End Sub

Thank You So much Alex for your assistance with this matter.

 

[Alex Blakenburg]

You're welcome, Glad I could help.