Verify that the workbook name exists and copy the data

[sofas]

Welcome.
The code works fine for me when I create the workbook for the first time. However, when the workbook is found, the data is copied over the previous data
Please help in completing it so that I can copy the data below the previous one

Function CheckForExistingWorkbooks() As Workbook
Dim wb1 As Workbook
Dim thisWb As Workbook
Set thisWb = ThisWorkbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim filename As String
filename = Range("d2").Value

lastrow = thisWb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

    Dim TestStr As String, FilePath As String
    FilePath = ThisWorkbook.Path & filename & ".xlsx"
    If Len(Dir(FilePath)) = 0 Then
        Set wb1 = Workbooks.Add
        
        
thisWb.Sheets(1).Range("A1:M" & lastrow).Copy
        
        With wb1.Worksheets(1).Range("A1")
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        .PasteSpecial Paste:=xlPasteFormats
        .PasteSpecial Paste:=xlPasteColumnWidths
     End With
        
  
wb1.SaveAs ThisWorkbook.Path & "\data\" & filename & ".xlsx", FileFormat:=51
    wb1.Close
    
    Else
    
    
    Set wb1 = Workbooks.Open(FilePath)
    
'    When you verify that the file already exists, the data
'    is copied into the same worksheet below the previous data

wb1.SaveAs ThisWorkbook.Path & "\data\" & filename & ".xlsx", FileFormat:=51
  
    wb1.Close
    Set CheckForExistingWorkbooks = wb1
    End If
    
End Function

 

[BigBeachBananas]

How about this?

Function CheckForExistingWorkbooks() As Workbook
    Dim wb1 As Workbook
    Dim thisWb As Workbook
    Set thisWb = ThisWorkbook

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim filename As String
    filename = thisWb.Sheets(1).Range("D2").Value

    Dim lastrow As Long
    lastrow = thisWb.Sheets(1).Cells(thisWb.Sheets(1).Rows.Count, 1).End(xlUp).Row

    Dim FilePath As String
    FilePath = ThisWorkbook.Path & "\data\" & filename & ".xlsx"

    If Len(Dir(FilePath)) = 0 Then
        Set wb1 = Workbooks.Add

        thisWb.Sheets(1).Range("A1:M" & lastrow).Copy

        With wb1.Sheets(1).Range("A1")
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteColumnWidths
        End With

        wb1.SaveAs ThisWorkbook.Path & "\data\" & filename & ".xlsx", FileFormat:=51
        wb1.Close
    Else
        Set wb1 = Workbooks.Open(FilePath)

        Dim lastUsedRow As Long
        lastUsedRow = wb1.Sheets(1).Cells(wb1.Sheets(1).Rows.Count, 1).End(xlUp).Row

        Dim pasteRow As Long
        pasteRow = lastUsedRow + 1

        thisWb.Sheets(1).Range("A1:M" & lastrow).Copy
        wb1.Sheets(1).Cells(pasteRow, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        wb1.Sheets(1).Cells(pasteRow, 1).PasteSpecial Paste:=xlPasteFormats
        wb1.Sheets(1).Cells(pasteRow, 1).PasteSpecial Paste:=xlPasteColumnWidths

        wb1.SaveAs ThisWorkbook.Path & "\data\" & filename & ".xlsx", FileFormat:=51

        wb1.Close
        Set CheckForExistingWorkbooks = wb1
    End If

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Function

 

[sofas]

How about this?

Function CheckForExistingWorkbooks() As Workbook
    Dim wb1 As Workbook
    Dim thisWb As Workbook
    Set thisWb = ThisWorkbook

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim filename As String
    filename = thisWb.Sheets(1).Range("D2").Value

    Dim lastrow As Long
    lastrow = thisWb.Sheets(1).Cells(thisWb.Sheets(1).Rows.Count, 1).End(xlUp).Row

    Dim FilePath As String
    FilePath = ThisWorkbook.Path & "\data\" & filename & ".xlsx"

    If Len(Dir(FilePath)) = 0 Then
        Set wb1 = Workbooks.Add

        thisWb.Sheets(1).Range("A1:M" & lastrow).Copy

        With wb1.Sheets(1).Range("A1")
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteColumnWidths
        End With

        wb1.SaveAs ThisWorkbook.Path & "\data\" & filename & ".xlsx", FileFormat:=51
        wb1.Close
    Else
        Set wb1 = Workbooks.Open(FilePath)

        Dim lastUsedRow As Long
        lastUsedRow = wb1.Sheets(1).Cells(wb1.Sheets(1).Rows.Count, 1).End(xlUp).Row

        Dim pasteRow As Long
        pasteRow = lastUsedRow + 1

        thisWb.Sheets(1).Range("A1:M" & lastrow).Copy
        wb1.Sheets(1).Cells(pasteRow, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        wb1.Sheets(1).Cells(pasteRow, 1).PasteSpecial Paste:=xlPasteFormats
        wb1.Sheets(1).Cells(pasteRow, 1).PasteSpecial Paste:=xlPasteColumnWidths

        wb1.SaveAs ThisWorkbook.Path & "\data\" & filename & ".xlsx", FileFormat:=51

        wb1.Close
        Set CheckForExistingWorkbooks = wb1
    End If

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Function

Wonderful...thank you very much. This is what is really needed.