Здравствуйте, в книге 4 листа, у меня есть код, который сохраняет и импортит только 1 лист из книги. Помогите поправить код, что бы был бекап и так же импорт 3х последних листов с сохранением названий этих листов. Файл пример приложил.
Код:
Код:
Код |
---|
Sub Backup() Application.ScreenUpdating = False Dim FileName$ If MsgBox("Backup?", vbQuestion + vbYesNo, "Backup") = vbNo Then Exit Sub Else Application.ThisWorkbook.Sheets(2).Unprotect ("") On Error Resume Next FileName = Application.GetSaveAsFilename(".xlsx", "Excel (*.xlsx),", , , Empty) If FileName = "False" Then GoTo Ex Err.Clear: ThisWorkbook.Sheets(2).Copy: DoEvents If Err Then GoTo Ex If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then Application.DisplayAlerts = False Application.EnableEvents = False ActiveWorkbook.SaveAs FileName, xlOpenXMLWorkbook ActiveWorkbook.DisplayAlerts = True Application.EnableEvents = True ActiveWorkbook.Close False If Err = 1004 Then GoTo Ex MsgBox "Created!", 64, "Backup" End If End If Ex: Application.ThisWorkbook.Sheets(2).Protect (""), UserInterfaceOnly:=True Application.ScreenUpdating = True End Sub Sub Import() Application.ScreenUpdating = False Dim i$, j&, k& If MsgBox("Replace?", vbQuestion + vbYesNo, "Import") = vbNo Then Exit Sub Else Application.ThisWorkbook.Sheets(2).Unprotect ("") On Error GoTo Ex Workbooks.Open FileName:=Application.GetOpenFilename i = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name j = ThisWorkbook.Sheets(2).UsedRange.Rows.Count + 1 k = GetObject(i).Sheets(1).UsedRange.Rows.Count + 1 Application.DisplayAlerts = False Application.EnableEvents = False GetObject(i).Sheets(1).Range(Cells(2, 1), Cells(k, 197)).Copy: GetObject(i).Close Application.DisplayAlerts = True Application.EnableEvents = True ThisWorkbook.Sheets(2).Activate ThisWorkbook.Sheets(2).Range(Cells(2, 1), Cells(j, 197)).ClearContents ThisWorkbook.Sheets(2).Range("A2").Select: ActiveSheet.Paste ThisWorkbook.Sheets(1).Activate Application.Caption = IIf(False = True, Empty, "") Application.DisplayStatusBar = False MsgBox "Imported!", 64, "Import" Ex: Application.ThisWorkbook.Sheets(2).Protect (""), UserInterfaceOnly:=True: ThisWorkbook.Save End If Application.ScreenUpdating = True End Sub |