VBA loop to duplicate sheets between one existing excel file and anew one

[ND1979]

Hello everyone, I am new to VBA for excel and I would like your help for a problem.

I have two excels, A and B to be created in runtime. I need to copy only the values of all the worksheets from A (except one), to B, without specific filters or range.

The following code copies all the sheets of A to B but it always does it on the same sheet of B. I tried to write the instruction to create new sheets in B but I get strange index errors.

Any help is welcome.

Thanks

Sub Finalize()

    Dim xlsxFullName As String
    Dim newWb As Workbook
    Dim wkSht As Worksheet
    Dim destSheet As Worksheet
    'Dim i As Integer
    
    
    
    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Save sheet values"
        If .Show Then
            xlsxFullName = .SelectedItems(1)
        Else
            xlsxFullName = ""
        End If
    End With
    
    If xlsxFullName <> "" Then
    
    Set newWb = Workbooks.Add
    
    'i = 0
    
    For Each wkSht In ThisWorkbook.Sheets
       'i = i + 1
        If wkSht.Name <> "MAIN" Then
        wkSht.Cells.Copy
        'Set destSheet = newWb.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
        ' Reponse = MsgBox(destSheet.Name, vbInformation)
        'newWb.Worksheets(destSheet).Paste
         newWb.Worksheets(1).Paste
          With newWb.Worksheets(1).UsedRange
           .Value = .Value
          End With
        newWb.Worksheets(1).Name = wkSht.Name
        End If
    Next
        'ThisWorkbook.Worksheets("Sheet2").Cells.Copy
        'newWb.Worksheets(1).Paste
        'With newWb.Worksheets(1).UsedRange
         '   .Value = .Value
        'End With
        'newWb.Worksheets(1).Name = "Sheet2"
        
        'Suppress warning if new workbook already exists
        Application.DisplayAlerts = False
        
    On Error Resume Next
    newWb.SaveAs xlsxFullName, FileFormat:=xlOpenXMLWorkbook
    newWb.Close SaveChanges:=False
    If Err.Number = 0 Then
      MsgBox "Values and formatting saved as " & xlsxFullName, vbInformation
        Else
            MsgBox "Errors, file not saved", vbExclamation
        End If
     On Error GoTo 0
      
    Application.DisplayAlerts = True
    
    End If
    
End Sub

 

[NoSparks]

This would copy the sheets to a workbook automatically created at the time

    Dim wkSht As Worksheet
    Dim i As Long
    Dim shtList As String
    Dim shtArray As Variant
    
    ' create string of sheets to be copied
    With ThisWorkbook
        For i = 1 To .Sheets.Count
            If Sheets(i).Name <> "MAIN" Then
                shtList = shtList & "," & Sheets(i).Name
            End If
        Next i
        ' create new workbook with sheets in shtList
        shtArray = Split(Mid(shtList, 2), ",")
        .Sheets(shtArray).Copy
        ' new workbook is automatically active
    End With
    
    ' work with new workbook
    With ActiveWorkbook
        ' usedrange to values
        For Each wkSht In .Sheets
            wkSht.UsedRange.Value = wkSht.UsedRange.Value
        Next wkSht
    End With

 

[ND1979]

Many thanks!!!
It works but now I need to learn your code because not all is so clear for me
The next step is check if I can crate this new file in read only blocking the editing of the cells but it will be a plus.
Thanks a lot, again, for your time and your help