Office: (Office 365) Tabellenblätter separat speichern

Hallo,

ich habe einen Code, der es ermöglicht, alle Tabellenblätter aus einer Excel-Datei separat abzuspeichern. Was mir hier fehlt, wäre die Option jedes exportiere Blatt immer in Kombination mit einem bestimmten anderen Blatt auszuleiten. Dabei handelt es sich um ein ausgeblendetes Blatt.
Kann jemand helfen den Code entsprechend zu erweitern?

Sub SplitWorkbook()
'Updateby20200806
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim xNWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook

DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString

If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
Select Case xWb.FileFormat
Case 51:
FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If Application.ActiveWorkbook.HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56:
FileExtStr = ".xls": FileFormatNum = 56
Case Else:
FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If

MkDir FolderName

For Each xWs In xWb.Worksheets
On Error GoTo NErro
If xWs.Visible = xlSheetVisible Then
xWs.Select
xWs.Copy
xFile = FolderName & "\" & xWs.Name & FileExtStr
Set xNWb = Application.Workbooks.Item(Application.Workbooks.Count)
xNWb.SaveAs xFile, FileFormat:=FileFormatNum
xNWb.Close False, xFile
End If
NErro:
xWb.Activate
Next

MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub

 

Hola,
verlinkst du bitte deine Fragen in allen Foren gegenseitig?
Danke!
Gruß,
steve1da