Copy sheets từ file này sang file kia theo danh sách (1 người xem)

Sub CopyData()
    Dim wsList As Worksheet
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim folderPath As String
    Dim fileName As String
    Dim lastRow As Long
    Dim i As Long
    Dim sourceName As String
    Dim finalName As String
    Dim fd As FileDialog

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    
    Set wsList = ThisWorkbook.Sheets("LIST")
    lastRow = wsList.Cells(wsList.Rows.Count, 1).End(xlUp).Row

    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)

    If fd.Show <> -1 Then Exit Sub
    folderPath = fd.SelectedItems(1) & "\"

    fileName = Dir(folderPath & "*.xls*")

    Do While fileName <> ""

        Set wbSource = Workbooks.Open(folderPath & fileName)

        For i = 2 To lastRow

            sourceName = wsList.Cells(i, 1).Value
            finalName = wsList.Cells(i, 2).Value

            On Error Resume Next
            Set wsSource = wbSource.Sheets(sourceName)
            Set wsTarget = ThisWorkbook.Sheets(finalName)
            On Error GoTo 0

            If Not wsSource Is Nothing And Not wsTarget Is Nothing Then
                wsTarget.Cells.Clear
                wsSource.Cells.Copy
                wsTarget.Range("A1").PasteSpecial xlPasteAll
            End If

            Set wsSource = Nothing
            Set wsTarget = Nothing

        Next i

        wbSource.Close False
        fileName = Dir

    Loop

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

    MsgBox "Done!"

End Sub