# copy sheets from main workbook to new one then clear ranges in all the sheets in new workbook



## bthyaabd (Dec 20, 2022)

i am trying to duplicate my main workbook (copy and paste all the sheets), then in the newly duplicated workbook  i need to clear from each sheet a specific range. Once the ranges are cleared then i need to copy from main sheets the last row of every sheet and paste it in the newly created workbook

In the code that i have i managed to copy/paste all the sheets and save the new workbook as macro enabled. 

the problem i am having is when i try to clear contents from the "Main" sheet in the new workbook my code is clearing the contents and creating a new sheet also so i am having 2 sheet named main and main2 
also i am not able to clear other sheets because it will do the same thing as the main sheet.

please help.
thank you

 Sub Closing_year()


    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long
    Dim ws As Worksheet
    Dim ws_temp As Worksheet
    Dim wsname As String
    Dim thiswb As Workbook
    Set thiswb = ThisWorkbook
    Dim MainSheet As Worksheet
    Dim MainLastRow As Long
    Dim PSheet As Worksheet
    Dim LastRowP As Long
    Dim PSheetName As String
    Dim SuppSheet As Worksheet
    Dim SuppLastRow As Long
    Dim AccSheet As Worksheet
    Dim AccLastRow As Long
    Dim i As Integer







    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then


        fname = Application.GetSaveAsFilename(InitialFileName:="", _
        filefilter:="Excel Files (*.xls), *.xls", _
        Title:="This example copies the ActiveSheet to a new workbook")

        If fname <> False Then

            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook


            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If
    Else


        fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
            " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
            " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
            " Excel 2000-2003 Workbook (*.xls), *.xls," & _
            " Excel Binary Workbook (*.xlsb), *.xlsb", _
            FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")


        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select


            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else

                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook
                For Each ws In ThisWorkbook.Sheets
                ws.Copy After:=NewWb.Sheets(NewWb.Worksheets.Count)
                Next

                Set ws = NewWb.Sheets("Main")
                ws.Unprotect Password:="123"

                 With ws
                    MainLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
                End With

                ws.Range("B28:M" & MainLastRow).ClearContents
                Set MainSheet = ThisWorkbook.Sheets("Main")
                MainSheet.Unprotect Password:="123"
                MainSheet.Range("A" & MainLastRow).Copy
                ws.Cells(28, "C").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing

            End If
        End If
    End If
End Sub


----------

