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.
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.