Нужно создать новый документ и скопировать 2 таблицы из основного документа. 1ю таблицу в новом созданном файле поместить на "A1", 2ю таблицу - на "H1". Написал примерный код, но он даже не сохраняет новый документ.
Код
Sub Backup()
Dim Filename$
If MsgBox("Back up?", vbQuestion + vbYesNo, "Back up") = vbNo Then
Exit Sub
Else
Application.ActiveSheet.Unprotect ("")
On Error Resume Next
Filename = Application.GetSaveAsFilename(".xlsx", "Excel (*.xlsx),", , , Empty)
If Filename = "False" Then GoTo Ex
GetObject(Filename).SaveAs Filename, xlOpenXMLWorkbook
MsgBox "Back up created!", 64, "Back up"
End If
Ex:
Application.ThisWorkbook.ActiveSheet.Protect (""), UserInterfaceOnly:=True
End Sub