SOLVED

VBA copy data from another workbook into current workbook (specific tab)

Copper Contributor

Hello,

I have my target workbook called "Troy Corporation Carrier Review March 2024.xlsx" and there's tab name call 'Detail". My target workbook is locate in the network folder which I am an admin and I have all rights and privilege

I also have all my excel files are in the same folder, but in a different sub-folder.

TTCBlueHill1_0-1714583456266.png

I need copy from the excel files mentioned above from column A to AA and from row 2 down and paste it to my target file "Troy Corporation Carrier Review March 2024.xlsx" to my "Detail" tab. So I want to paste the data start from column 'E' to column 'AE' and start in row 3.  Then when the next file start I want to continue paste it to the last row of the first file.  For example, if the first past ended with row 50, then next file will start on row 51 and so on...

 

Thank you an advance!

 

7 Replies

@TTC-BlueHill1 

Open the "Troy Corporation Carrier Review March 2024.xlsx" workbook.

Create a new workbook

Press Alt+F11 to activate the Visual Basic Editor.

Select Insert > Module.

Copy the code listed below into the module.

Then switch back to Excel.

If you want to be able to run the macro again later, save the new workbook as a macro-enabled workbook (*.xlsm). Otherwise, just run the macro, then discard the new workbook.

Sub ImportData()
    Dim wbkSource As Workbook
    Dim wshSource As Worksheet
    Dim lngLastSourceRow As Long
    Dim wbkTarget As Workbook
    Dim wshTarget As Worksheet
    Dim lngTargetRow As Long
    Dim strFolder As String
    Dim strFile As String

    Application.ScreenUpdating = False
    Set wbkTarget = Workbooks("Troy Corporation Carrier Review March 2024.xlsx")
    Set wshTarget = wbkTarget.Worksheets("Detail")
    On Error Resume Next
    lngTargetRow = 2
    ' Path of the subfolder with the source workbooks
    strFolder = "N:\MyFolder\MySubfolder\"
    strFile = Dir(strFolder & "*.xls*")
    Do While strFile <> ""
        Set wbkSource = Workbooks.Open(Filename:=strFolder & strFile, ReadOnly:=True)
        Set wshSource = wbkSource.Worksheets(1)
        lngLastSourceRow = wshSource.Range("E:AE").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        wshSource.Range("E3:AE" & lngLastSourceRow).Copy Destination:=wshTarget.Range("A" & lngTargetRow)
        Application.CutCopyMode = False
        wbkSource.Close SaveChanges:=False
        lngTargetRow = lngTargetRow + lngLastSourceRow - 2
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

Thank so far. Correction
I need my source to start on A2 through AA
Paste
to my target file start on column E3 through AE

Sorry... it looks like I cannot paste my screenshot on the reply

Also, I need to keep my column headings on my target file. that's reason why I want to start on row 3 and column E.
for my source file I need to start on row A2, column A, row 2.
Thanks an advance!

@TTC-BlueHill1 

Sub ImportData()
    Dim wbkSource As Workbook
    Dim wshSource As Worksheet
    Dim lngLastSourceRow As Long
    Dim wbkTarget As Workbook
    Dim wshTarget As Worksheet
    Dim lngTargetRow As Long
    Dim strFolder As String
    Dim strFile As String

    Application.ScreenUpdating = False
    Set wbkTarget = Workbooks("Troy Corporation Carrier Review March 2024.xlsx")
    Set wshTarget = wbkTarget.Worksheets("Detail")
    On Error Resume Next
    lngTargetRow = 3
    ' Path of the subfolder with the source workbooks
    strFolder = "N:\MyFolder\MySubfolder\"
    strFile = Dir(strFolder & "*.xls*")
    Do While strFile <> ""
        Set wbkSource = Workbooks.Open(Filename:=strFolder & strFile, ReadOnly:=True)
        Set wshSource = wbkSource.Worksheets(1)
        lngLastSourceRow = wshSource.Range("A:AA").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        wshSource.Range("A2:AA" & lngLastSourceRow).Copy Destination:=wshTarget.Range("E" & lngTargetRow)
        Application.CutCopyMode = False
        wbkSource.Close SaveChanges:=False
        lngTargetRow = lngTargetRow + lngLastSourceRow - 2
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
Thank you sir and we're almost there.
The macro is not copy paste the very last row to the target file. I total the entire record and I should have 727 rows. But on the target file I got 724 rows. So I did a VLOOKUP to see which invoice# I did not get and I did checked and searched for the missing invoice# for all the source files and my result it did not copy the very last row and paste to the target file. Can you please make that small fixed and let me know?
Thanks an advanced!
best response confirmed by TTC-BlueHill1 (Copper Contributor)
Solution

@TTC-BlueHill1 

A correction:

Sub ImportData()
    Dim wbkSource As Workbook
    Dim wshSource As Worksheet
    Dim lngLastSourceRow As Long
    Dim wbkTarget As Workbook
    Dim wshTarget As Worksheet
    Dim lngTargetRow As Long
    Dim strFolder As String
    Dim strFile As String

    Application.ScreenUpdating = False
    Set wbkTarget = Workbooks("Troy Corporation Carrier Review March 2024.xlsx")
    Set wshTarget = wbkTarget.Worksheets("Detail")
    On Error Resume Next
    lngTargetRow = 3
    ' Path of the subfolder with the source workbooks
    strFolder = "N:\MyFolder\MySubfolder\"
    strFile = Dir(strFolder & "*.xls*")
    Do While strFile <> ""
        Set wbkSource = Workbooks.Open(Filename:=strFolder & strFile, ReadOnly:=True)
        Set wshSource = wbkSource.Worksheets(1)
        lngLastSourceRow = wshSource.Range("A:AA").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        wshSource.Range("A2:AA" & lngLastSourceRow).Copy Destination:=wshTarget.Range("E" & lngTargetRow)
        Application.CutCopyMode = False
        wbkSource.Close SaveChanges:=False
        lngTargetRow = lngTargetRow + lngLastSourceRow - 1
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
Thank you so much Sir! Everything work as expected!
1 best response

Accepted Solutions
best response confirmed by TTC-BlueHill1 (Copper Contributor)
Solution

@TTC-BlueHill1 

A correction:

Sub ImportData()
    Dim wbkSource As Workbook
    Dim wshSource As Worksheet
    Dim lngLastSourceRow As Long
    Dim wbkTarget As Workbook
    Dim wshTarget As Worksheet
    Dim lngTargetRow As Long
    Dim strFolder As String
    Dim strFile As String

    Application.ScreenUpdating = False
    Set wbkTarget = Workbooks("Troy Corporation Carrier Review March 2024.xlsx")
    Set wshTarget = wbkTarget.Worksheets("Detail")
    On Error Resume Next
    lngTargetRow = 3
    ' Path of the subfolder with the source workbooks
    strFolder = "N:\MyFolder\MySubfolder\"
    strFile = Dir(strFolder & "*.xls*")
    Do While strFile <> ""
        Set wbkSource = Workbooks.Open(Filename:=strFolder & strFile, ReadOnly:=True)
        Set wshSource = wbkSource.Worksheets(1)
        lngLastSourceRow = wshSource.Range("A:AA").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        wshSource.Range("A2:AA" & lngLastSourceRow).Copy Destination:=wshTarget.Range("E" & lngTargetRow)
        Application.CutCopyMode = False
        wbkSource.Close SaveChanges:=False
        lngTargetRow = lngTargetRow + lngLastSourceRow - 1
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

View solution in original post