Использование l oop для копирования и вставки нескольких листов из книги

Question

Я хочу иметь возможность открывать папку и выбирать файл. Затем я хотел бы скопировать и вставить все рабочие листы в выбранном файле вместе с его именем рабочего листа в эту книгу (где находится макрос).

Однако, когда я запускаю приведенный ниже код. Он не может l oop. Например, в выбранном файле есть 3 листа. Код скопируйте и вставьте первый рабочий лист 3 раза. И также он не копирует имя рабочего листа.

Кто-нибудь может мне в этом помочь. Очень признателен.

Sub Import_File()

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim FileName As String
Dim FilePath As String
Dim WS As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

FileToOpen = Application.GetOpenFilename(Title:="Browse your File")
FilePath = FileToOpen

If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)

   For Each WS In OpenBook.Worksheets
    
    Range("A2:XFD1048576").Copy
    ThisWorkbook.Worksheets.Add.Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
   
   Next WS

    OpenBook.Close
    FileName = Dir()
       
        
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End If

Answer 1

Sub Import_File()

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim WS As Worksheet

FileToOpen = Application.GetOpenFilename(Title:="Browse your File")

    If FileToOpen <> False Then
    
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
        End With
        
        With ThisWorkbook

           For Each WS In OpenBook.Worksheets             
                WS.Copy After:=.Sheets(.Sheets.Count)
           Next WS

        End With

        OpenBook.Close
        
    End If

    With Application
         .ScreenUpdating = True
         .DisplayAlerts = True
    End With    

End Sub