Sub QWERT()
Dim WB As Workbook, SB As Worksheet
Dim WI As Workbook, SI As Worksheet, LR
Set WI = ActiveWorkbook
Set WB = Workbooks.Add 'в новую книгу
      For Each SI In WI.Worksheets 'перебираем листы в книге-источнике
          LR = SI.Cells(SI.Rows.Count, 3).End(xlUp).Row 'определяем количество занятых строк текущеголиста
          Set SB = WB.Worksheets.Add 'добавляем новый лист в новую книгу
          SB.Range(SB.Cells(1, 3), SB.Cells(LR, 3)) = SI.Range(SI.Cells(1, 3), SI.Cells(LR, 3)).Value 'копируем значения
      Next
End Sub

Sub QWERT2()
Dim WB As Workbook, SB As Worksheet
Dim WI As Workbook, SI As Worksheet, LR As Long
Dim BookPath As String
Dim sovpal As Integer
Set WI = ActiveWorkbook
BookPath =  WI.Path & "\"
NameCopyBook = "Пример2.xlsx" 'необходимо ввести самому, обязательно с расширением!!!
Set WB = Workbooks.Open(BookPath & NameCopyBook) 'открываем книгу-дубликат
       For Each SI In WI.Worksheets 'перебираем листы в книге-источнике
           LR = SI.Cells(SI.Rows.Count, 3).End(xlUp).Row 'определяем количество занятых строк текущего листа
           For Each SB In WB.Worksheets
           If SB.Name = SI.Name Then
              SB.Range(SB.Cells(1, 3), SB.Cells(LR, 3)) = SI.Range(SI.Cells(1, 3), SI.Cells(LR, 3)).Value 'копируем значения
           Next SB
       Next SI
End Sub

Sub Копия()
      Dim Sh As Worksheet, iPath$, fa$, fk$
      iPath = ThisWorkbook.Path & "\"
      Application.ScreenUpdating = False: Application.DisplayAlerts = False
      fa = ThisWorkbook.Name 'файл активный (рабочий)
      fk = Mid(fa, 1, Len(fa) - 4) & "-копия" & ".xls" 'файл копия
      'если расширение файла больше 3-х букоф, 4 заменить на 5
          
      ThisWorkbook.Save 'сохраняем активный (рабочий) файл
      ActiveWorkbook.SaveCopyAs iPath & fk  'сохраняем файл как копию
      Workbooks.Open iPath & fk 'открываем файл копию и далее обрабатываем
      For Each Sh In Workbooks(fk).Sheets
        'Workbooks(fk).Sheets(Sh.Name).Buttons.Delete 'Удаляем кнопки
        'Workbooks(fk).Sheets(Sh.Name).DrawingObjects.Delete 'Удаляем все элементы
        Workbooks(fk).Sheets(Sh.Name).UsedRange.Value = Workbooks(fk).Sheets(Sh.Name).UsedRange.Value
      Next Sh
      Windows(fa).Activate 'активируем (рабочий) файл
      Workbooks(fk).Save 'сохраняем файл копию
      Workbooks(fk).Close 'закрываем файл копию
      Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub

'Выделить диапазон который необходимо скопировать
Range("A1:F52").Select

Sub QWERT2()
Dim WB As Workbook, SB As Worksheet
Dim WI As Workbook, SI As Worksheet, LR As Long
Dim BookPath As String
Dim sovpal As Integer
Set WI = ActiveWorkbook
BookPath =  WI.Path & "\"
NameCopyBook = "Пример2.xlsx" 'необходимо ввести самому, обязательно с расширением!!!
Set WB = Workbooks.Open(BookPath & NameCopyBook) 'открываем книгу-дубликат
     For Each SI In WI.Worksheets 'перебираем листы в книге-источнике
         LR = SI.Cells(SI.Rows.Count, 3).End(xlUp).Row 'определяем количество занятых строк текущего листа
         For Each SB In WB.Worksheets
         If SB.Name = SI.Name Then
             SB.Range(SB.Cells(1, 3), SB.Cells(LR, 3)) = SI.Range(SI.Cells(1, 3), SI.Cells(LR, 3)).Value 'копируем значения
         end If
         Next SB
     Next SI
End Sub

Sub QWERT2()
Dim WB As Workbook, SB As Worksheet
Dim WI As Workbook, SI As Worksheet, LR As Long
Dim BookPath As String
Dim sovpal As Integer
Set WB = ActiveWorkbook
BookPath =  WI.Path & "\"
NameCopyBook = "Файл-исходник.xls" 'необходимо ввести самому, обязательно с расширением!!!
Set WI = Workbooks.Open(BookPath & NameCopyBook) 'открываем книгу-дубликат
     For Each SI In WI.Worksheets 'перебираем листы в книге-источнике
         LR = SI.Cells(SI.Rows.Count, 3).End(xlUp).Row 'определяем количество занятых строк текущего листа
         For Each SB In WB.Worksheets
         If SB.Name = SI.Name Then
             SB.Range(SB.Cells(1, 3), SB.Cells(LR, 3)) = SI.Range(SI.Cells(1, 3), SI.Cells(LR, 3)).Value 'копируем значения
         end If
         Next SB
     Next SI
End Sub

Sub QWERT2()
Dim WB As Workbook, SB As Worksheet
Dim WI As Workbook, SI As Worksheet, LR As Long
Dim BookPath As String
Dim sovpal As Integer
Set WB = ActiveWorkbook
BookPath =  WB.Path & "\"
NameCopyBook = "Файл-исходник.xls" 'необходимо ввести самому, обязательно с расширением!!!
Set WI = Workbooks.Open(BookPath & NameCopyBook) 'открываем книгу-дубликат
     For Each SI In WI.Worksheets 'перебираем листы в книге-источнике
         LR = SI.Cells(SI.Rows.Count, 3).End(xlUp).Row 'определяем количество занятых строк текущего листа
         For Each SB In WB.Worksheets
         If SB.Name = SI.Name Then
             SB.Range(SB.Cells(1, 3), SB.Cells(LR, 3)) = SI.Range(SI.Cells(1, 3), SI.Cells(LR, 3)).Value 'копируем значения
         end If
         Next SB
     Next SI
End Sub

fk = Mid(fa, 1, Len(fa) - 4) & "-копия" & ".xls" 'файл копия
      'если расширение файла больше 3-х букоф, 4 заменить на 5