Forum Discussion

TTC-BlueHill1's avatar
TTC-BlueHill1
Copper Contributor
May 01, 2024

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

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.

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!

 

  • HansVogelaar's avatar
    HansVogelaar
    May 01, 2024

    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
  • 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

     

    • TTC-BlueHill1's avatar
      TTC-BlueHill1
      Copper Contributor
      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
    • TTC-BlueHill1's avatar
      TTC-BlueHill1
      Copper Contributor

      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!

      • HansVogelaar's avatar
        HansVogelaar
        MVP

        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

Resources