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

[bthyaabd]

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