Copy Sheet to New Workbook

Question

I am hoping someone can assist. I have an excel macro filing (.xlsm) where I am pulling in data from other files and I am creating multiple Worksheets. I am trying to export one of those worksheets to a new Workbook that I'm creating each day with a dynamic file name, the file name includes the current date. I'm getting an error that "Excel cannot insert the sheets into the destination workbook, because it contains few rows and columns than the source workbook...". I assume this is because I am attempting to copy from.xlsm to.xlxs and I'm not sure how to solve this. Here is the code that I have:

Dim wb As Workbook
    Set wb = Workbooks.Add
    ThisWorkbook.Sheets("Data").Copy Before:=wb.Sheets(1)
    wb.SaveAs "\\NetorkDrive\Filename " & Format(Now(), "MM_DD_YY") & ".xlsx"

I was expecting the information from the "Data" sheet to copy over to a new Workbook titled "Filename Date.xlsx" but I am getting the error referenced above.

Answer 1

Export Worksheet To a New Workbook

Sub ExportWorksheet()

    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = swb.Sheets("Data")
    
    sws.Copy ' creates a single-worksheet workbook
    
    Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count) ' the last
    
    Dim dPath As String
    dPath = "\\NetworkDrive\Filename " & Format(Date, "MM_DD_YY") & ".xlsx"
    
    Application.DisplayAlerts = False ' overwrite without confirmation
        dwb.SaveAs dPath, xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    'dwb.Close SaveChanges:=False ' it just got saved
    
    MsgBox "Worksheet exported.", vbInformation

End Sub