Copy Worksheet to a New Excel Document and SaveAs...

Hi,

I have a Excel Workbook and want to copy a specific Worksheet to a new Workbook (.xlsx Format) and save it with a specific name.
The following macro function is triggered after clicking the save button. The new generated Excel Workbook should be replaced every time after clicking the save button.

Code:

---

Public Sub fkt_Copy()
    Dim str_Path_Dest As String
    Dim str_FileName As String
    Dim str_DestPathName As String
    Dim bFileExists, bFileOpen As Boolean
    Dim xApp As Excel.Application
    Dim xWbk As Workbook
    Dim ws As Worksheet
    Dim wb As Workbook
    Set wb = Workbooks("BasisDocument")
    bFileExists = False
    bFileOpen = False
  On Error GoTo 0
  str_Path_Dest = "C:\Documents\TEST\"
  str_FileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
  str_DestPathName = str_Path_Dest & "\" & str_FileName & ".xlsx"
  Set xWbk = Workbooks.Add
  xWbk.SaveAs filename = str_Path_Dest & str_FileName & ".xlsx"
    If Dir(str_DestPathName) <> "" Then
  bFileExists = True
  If Not IsFileOpen(str_DestPathName) Then
  bFileOpen = False
  End If
  End If
  If Not bFileOpen Or Not bFileExists Then
  Set xWbk = Workbooks.Add
  xWbk.SaveAs filename = str_Path_Dest & "str_FileName" & ".xlsx"
  If wb.Worksheets("Sheet1").FilterMode Then
  Worksheets("Sheet").ShowAllData
  End If
  wb.Worksheets("Sheet1").UsedRange.Copy

  xWbk.UsedRange.PasteSpecial xlPasteValue

    xWbk.SaveAs filename = str_Path_Dest & str_FileName, xlOpenXMLWorkbook
  xWbk.Close
  End If     
  Exit Sub
End Sub

---

This Code does not paste the Sheet to the new generated Excel workbook.

You should be able to adapt this to suit. Obviously, you just want the one sheet copied. You can pass the value of prefix to "". You can change the routine to save with a more custom name too if needed.

Code:

---

Sub Test_CopySheet() 
  Dim oSheet As Worksheet
  Dim prefix As String
  Dim thePath As String
 
  prefix = "Master_"
  thePath = ThisWorkbook.Path & "\"
 
  For Each oSheet In ThisWorkbook.Sheets
    CopySheet oSheet, thePath, prefix
  Next oSheet
End Sub


Sub CopySheet(sht As Worksheet, thePath As String, prefix As String)
    Dim wb As Workbook
    Set wb = Workbooks.Add(xlWBATWorksheet)
    sht.Copy after:=wb.Sheets(1)
    Application.DisplayAlerts = False
    wb.Sheets(1).Delete
    Application.DisplayAlerts = True
    wb.ActiveSheet.Name = sht.Name
    wb.SaveAs thePath & prefix & sht.Name & ".xlsx"
    wb.Close False
End Sub

---

Hello Kenneth thank you for repyling. Unfortunately I have the error message for "CopySheet oSheet" in the first part of the code that the argumnt type byref is incompatible.

Did you use that code in Test or a modification?

There is a slight difference between Sheets and Worksheets.

Code:

---

For Each oSheet In ThisWorkbook.WorksSheets

---

Hello Kenneth thank you very much