Macro to Append Data

Hi ExcelQ1

Try this

Option Explicit
Sub UpDate_Book2()
    Dim wbData As Workbook
    Dim wbTarget As Workbook
    Dim wsData As Worksheet
    Dim wsTarget As Worksheet
    Dim LR As Long
    Dim MyPath As String
    Application.ScreenUpdating = False
    MyPath = ActiveWorkbook.Path
    Set wbData = ThisWorkbook
    Application.Workbooks.Open (MyPath & "\" & "Book2.xls")
    Set wbTarget = Workbooks("Book2.xls")
    For Each wsData In wbData.Sheets
        For Each wsTarget In wbTarget.Sheets
            If wsTarget.Name = wsData.Name Then
                LR = wsTarget.Range("A" & Rows.Count).End(xlUp).Row
                If Not LR = 1 Then LR = LR + 1
                wsData.Range("A1:J2").Copy Destination:=wsTarget.Range("A" & LR)
                Exit For
            End If
        Next wsTarget
    Next wsData
    wbTarget.Close savechanges:=True
    Application.ScreenUpdating = True
End Sub

Let me know of issues.

John