PDA

View Full Version : Copy Worksheet to a New Excel Document and SaveAs...



Cinema
01-12-2019, 03:26 PM
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.


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.

Kenneth Hobs
01-12-2019, 05:03 PM
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.


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

Cinema
01-13-2019, 07:47 AM
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.

Kenneth Hobs
01-13-2019, 10:00 AM
Did you use that code in Test or a modification?

There is a slight difference between Sheets and Worksheets.

For Each oSheet In ThisWorkbook.WorksSheets

Cinema
01-13-2019, 01:33 PM
Hello Kenneth thank you very much