How to copy data from two workbooks and append to another workbook?

Hi

I have two Workbooks which are called workbook 1 and 2. I want to append the data in this to workbook 3. The data that needs to be appended ignores the headers in the other tables and i just want workbook 1 data copied into workbook 3 and then workbook 2 data copied right underneath the data from workbook 1 in workbook 3.

Here's my code atm:

Sub Copy()

Dim fileDialog As fileDialog
Dim strPathFile_1 As String
Dim strPathFile_2 As String
Dim strFileName As String
Dim dialogTitle As String
Dim target_wbk As Workbook
Dim target_rows As Long
Dim source_rows_1 As Long
Dim source_rows_2 As Long

dialogTitle = "Navigate to and select required file."
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
With fileDialog
.InitialFileName = "C:\Users\IsuruGaj\Downloads"
'.InitialFileName = ThisWorkbook.Path & "\" 'Alternative to previous line
.AllowMultiSelect = True
.Filters.Clear
.Title = dialogTitle
If .Show = False Then
MsgBox "File not selected to import. Process Terminated"
Exit Sub
End If
strPathFile_1 = .SelectedItems(1)
strPathFile_2 = .SelectedItems(2)
End With

Set source_wbk_1 = Workbooks.Open(Filename:=strPathFile_1)
Set source_wbk_2 = Workbooks.Open(Filename:=strPathFile_2)
Set target_wbk = ThisWorkbook

' Get amount of rows in input source and output target
target_rows = target_wbk.Sheets("Copy").UsedRange.Rows.Count
source_rows_1 = source_wbk_1.Sheets(1).UsedRange.Rows.Count - 2
source_rows_2 = source_wbk_2.Sheets(1).UsedRange.Rows.Count - 2
MsgBox "target: " & target_rows & "| source1: " & source_rows_1 & "| source2: " & source_rows_2

' ' Delete the previous data in the target workbook
target_wbk.Sheets("Copy").Range("A2" & ":K" & target_rows).Delete
'
' ' Copy all the data in the source workbook
source_wbk_1.Sheets(1).Range("A2" & ":K" & source_rows_1).Copy
source_wbk_2.Sheets(1).Range("A2" & ":K" & source_rows_2).Copy
' ' Paste all the data from the source workbook into the target workbook
target_wbk.Sheets("Copy").Range("A2" & ":K" & source_rows_1).PasteSpecial

source_wbk_1.Save
source_wbk_1.Close
source_wbk_2.Save
source_wbk_2.Close
MsgBox ("WO Import Complete")


End Sub

I've got my first workbook to copy to workbook 3 however I don't know how to append workbook 2 data right underneath the previous copied data from workbook 1.

I believe this line needs to be edited. target_wbk.Sheets("Copy").Range("A2" & ":K" & source_rows_1).PasteSpecial

Please help!!

Hi I get a runtime error '9' - Subscript out of range in running the following code for the line (wbk1.Sheets("Sheet1").Range("$A:$K").Copy wbk3.Sheets("Copy").Range("$A:$K") 'Change the Sheet name and data range accordingly)

Sub CombineWBks()
Dim strFirstFile, strSecondFile, strThirdFile, dialogTitle As String
Dim wbk1, wbk2, wbk3 As Workbook
Dim fileDialog As fileDialog

'Speeding up the macro
Application.ScreenUpdating = False
EventState = Application.EnableEvents
Application.EnableEvents = False
CalcState = Application.Calculation
Application.Calculation = xlCalculationManual
PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False
Application.DisplayAlerts = False

dialogTitle = "Navigate to and select required file."
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
'Change file path to match your files locations
With fileDialog
.InitialFileName = "C:\Users\IsuruGaj\Downloads"
'.InitialFileName = ThisWorkbook.Path & "\" 'Alternative to previous line
.AllowMultiSelect = True
.Filters.Clear
.Title = dialogTitle
If .Show = False Then
MsgBox "File not selected to import. Process Terminated"
Exit Sub
End If
strFirstFile = .SelectedItems(1)
strSecondFile = .SelectedItems(2)
End With

strThirdFile = "X:\EAPM\Command Centre\Status report\TfNSW CoE - Weekly Remedy Status Report_version4.xlsm"
Set wbk1 = Workbooks.Open(Filename:=strFirstFile)
'Set wbk_2 = Workbooks.Open(Filename:=strSecondFile)
Set wbk3 = Workbooks.Open(strThirdFile)

' strFirstFile = "C:\_ExcelForum\CombineWorkbooks\Workbook 1.xlsx" 'Change to your location & ensure the workbook exist
' strSecondFile = "C:\_ExcelForum\CombineWorkbooks\Workbook 2.xlsx" 'Change to your location & ensure the workbook exist
' strThirdFile = "C:\_ExcelForum\CombineWorkbooks\Workbook 3.xlsx" 'Change to your location & ensure the workbook exist


'Clears data within sheet1 of the third file
'wbk3.Sheets("sheet1").UsedRange.ClearContents 'Clears the third file's data (used only for testing}

'Copy process begins
wbk1.Sheets("Sheet1").Range("$A:$K").Copy wbk3.Sheets("Copy").Range("$A:$K") 'Change the Sheet name and data range accordingly
wbk1.Close

Set wbk2 = Workbooks.Open(Filename:=strSecondFile)

wbk2.Sheets("Sheet1").Range("$A2:$K").Copy wbk3.Sheets("Copy").Range("A2" & Rows.Count).End(xlUp).Offset(1, 0) 'Change the Sheet name and data range accordingly

wbk3.Save
wbk3.Close

'Restoring Speeding up the macro
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAuto
ActiveSheet.DisplayPageBreaks = True

End Sub

When you run the script, does it open workbook 1 and 3?
If both workbooks open, ensure that the sheet names reflect what you indicated in the code.

I will get back to you as I need to test your version of the code.

I need to open two workbooks that need to be imported into the original workbook. This means workbook 1 and 2 have file names that are always not the same but are in the same format. i.e Workbook 1 could be named "Workbook 1 (2)" and the next day it will be named "Workbook 2 (3)". I'm basically trying to import it using the dialogue prompt.

Please let me know how to get past this error

I did not run into an error for this line of code

wbk1.Sheets("Sheet1").Range("$A:$K").Copy wbk3.Sheets("Copy").Range("$A:$K") 'Change the Sheet name and data range accordingly

However, I did have an issue with this line

wbk2.Sheets("Sheet1").Range("$A2:$K").Copy wbk3.Sheets("Copy").Range("A2" & Rows.Count).End(xlUp).Offset(1, 0) 'Change the Sheet name and data range accordingly

Please retry the full code below. Remember to pay attention to the notes in the code

Sub CombineWBks()
  Dim strFirstFile, strSecondFile, strThirdFile, dialogTitle As String
  Dim wbk1, wbk2, wbk3 As Workbook
  Dim fileDialog As fileDialog

'Speeding up the macro
  Application.ScreenUpdating = False
  EventState = Application.EnableEvents
  Application.EnableEvents = False
  CalcState = Application.Calculation
  Application.Calculation = xlCalculationManual
  PageBreakState = ActiveSheet.DisplayPageBreaks
  ActiveSheet.DisplayPageBreaks = False
  Application.DisplayAlerts = False

  dialogTitle = "Navigate to and select required file."
   Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)

   With fileDialog
    .InitialFileName = "C:\_ExcelForum\CombineWorkbooks\" 'CHANGE THE INITIAL FILE LOCATION
   '.InitialFileName = ThisWorkbook.Path & "\" 'Alternative to previous line
    .AllowMultiSelect = True
    .Filters.Clear
    .Title = dialogTitle
   
   If .Show = False Then
    MsgBox "File not selected to import. Process Terminated"
Exit Sub
   End If
   
  strFirstFile = .SelectedItems(1)
  strSecondFile = .SelectedItems(2)
   End With

  strThirdFile = "C:\_ExcelForum\CombineWorkbooks\Test.xlsm"
  
  Set wbk1 = Workbooks.Open(Filename:=strFirstFile)
  Set wbk2 = Workbooks.Open(Filename:=strSecondFile)
  Set wbk3 = Workbooks.Open(strThirdFile)

'COPY PROCESS BEGINS
      wbk1.Sheets("Sheet1").Range("$A:$K").Copy wbk3.Sheets("Copy").Range("$A:$K") 'CHANGE THE SHEET NAME & DATA RANGE ACCORDINGLY
      wbk1.Close

      wbk2.Sheets("Sheet1").Range("A2:K500000").Copy wbk3.Sheets("Copy").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 'CHANGE SHEET NAMES

      wbk2.Close
      wbk3.Save
      wbk3.Close

'Restoring Speeding up the macro
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAuto
  ActiveSheet.DisplayPageBreaks = True

End Sub