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

 

[Alex Blakenburg]

Can you clarify if my understanding is correct.
You have 2 workbooks (mandar1 & 2) with sheets 1 to 3 and you want them appended to sheets 1 to 3 of the workbook that contains the code.
And you want the file name of the data copied in, in the far right column of each sheet of the workbook that contains the code ?

 

[Alex Blakenburg]

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

 

[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

Yes ur understanding is correct, let me check n come back to you.

 

[James Clear]

Yes ur understanding is correct, let me check n come back to you.

It's giving an error - "C:\mandar-test\mandar1.xlsx", "C:\mandar-test\mandar2.xlsx"

CSaying can not access - Path is correct

Path given - "C:\Users\HP\OneDrive\Desktop\Automation\PE.xlsx", "C:\Users\HP\OneDrive\Desktop\Automation\PP.xlsx"

 

[James Clear]

Can you clarify if my understanding is correct.
You have 2 workbooks (mandar1 & 2) with sheets 1 to 3 and you want them appended to sheets 1 to 3 of the workbook that contains the code.
And you want the file name of the data copied in, in the far right column of each sheet of the workbook that contains the code ?

That's correct

 

[James Clear]

Hi All,

Pls assist.

 

[Alex Blakenburg]

It's giving an error - "C:\mandar-test\mandar1.xlsx", "C:\mandar-test\mandar2.xlsx"

CSaying can not access - Path is correct

Path given - "C:\Users\HP\OneDrive\Desktop\Automation\PE.xlsx", "C:\Users\HP\OneDrive\Desktop\Automation\PP.xlsx"

I am a bit confused. Did you replace the file paths in the code with your real file paths ?
Onedrive can prove problematic.

 

[James Clear]

I am a bit confused. Did you replace the file paths in the code with your real file paths ?
Onedrive can prove problematic.

Yes I did change the given paths and replaced with them with a real one

 

[Alex Blakenburg]

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.