Листы рабочих книг копируются в несколько рабочих книг и переименовываются

Question

У меня есть рабочая тетрадь и много листов, которые я хочу скопировать по одному листу в новую рабочую книгу и переименовать рабочую книгу

Я пытался, но он сохранил в одной книге вместо отдельных книг, и я не хочу копировать первый лист для копирования новой книги

Option Explicit

Sub CreateWorkBooks()
    Dim ws As Object
    Dim i As Long
    Dim ws_num As Integer
    Application.ScreenUpdating = False

    Set ws = Worksheets
    ws_num = ThisWorkbook.Worksheets.Count

    For i = 2 To ws_num
        'Copy one worksheet as a new workbook
        'The new workbook becomes the ActiveWorkbook
        ws.Copy

        'Replace all formulas with values (optional)
        ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

        'May want (not required) to add a file name extension (.xls or .xlsx) to the file name
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & _
          "AR Balance- " & ActiveSheet.Name & " " & Worksheets("DATA Sheet").Range("m2") & ".xlsx"
        ActiveWorkbook.Close SaveChanges:=False 
    Next 

    Application.ScreenUpdating = True
End Sub

Answer 1

Добро пожаловать на SO. Только простые самоочевидные исправления сделаны. Попробуйте

 Option Explicit
Sub CreateWorkBooks()
    Dim ws As Worksheet  ' Worksheets instead of Object
    Dim i As Long
    Dim ws_num As Integer
    'Application.ScreenUpdating = False


    ws_num = ThisWorkbook.Worksheets.Count

    For i = 2 To ws_num
    Set ws = ThisWorkbook.Worksheets(i)      'set ws to each sheet in the workbook
        'Copy one worksheet as a new workbook
        'The new workbook becomes the ActiveWorkbook
        ws.Copy

        'Replace all formulas with values (optional)
        ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

        'May want (not required) to add a file name extension (.xls or .xlsx) to the file name
        ' Thisworkbook  is to be added to refer Worksheets("DATA Sheet").Range("m2").Value
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & _
          "AR Balance- " & ActiveSheet.Name & " " & ThisWorkbook.Worksheets("DATA Sheet").Range("m2").Value & ".xlsx"

        ActiveWorkbook.Close False
    Next

    'Application.ScreenUpdating = True
End Sub