Code lấy dữ liệu từ 3 file con.

md(k, 11) = "VTF" & Mid(wn.Name, InStr(wn.Name, "WF") - 1, 1)

Option Explicit

Sub LayDuLieuSheetTonDau_TuCacFile()
Application.ScreenUpdating = False
Dim wd As Workbook, wn As Workbook
Dim sd As Worksheet, sn As Worksheet, sn1 As Worksheet, sn2 As Worksheet
Dim lrd As Long, lrn As Long, lrn1 As Long, lrn2 As Long
Dim i As Long, j As Long, k As Long, p As Long, q As Long
Dim md() As String, md1, md2, mn, mn1, mn2

Set wd = ThisWorkbook
Set sd = wd.Sheets("TonDau")
Set sn1 = wd.Sheets("DanhMuc")

lrn1 = sn1.Cells(Rows.Count, 2).End(xlUp).Row
mn1 = sn1.Range("B6:j" & lrn1)


ReDim md(1 To 2000, 1 To 11)
ReDim md1(1 To 2000, 1 To 6)

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
If .SelectedItems.Count = 0 Then Exit Sub
    For i = 1 To .SelectedItems.Count
        Set wn = Workbooks.Open(.SelectedItems(i), False)
        Set sn = wn.Sheets("BaoCao")
        
        If sn.AutoFilterMode = True Then sn.AutoFilterMode = False
        lrn = sn.Cells(Rows.Count, 2).End(xlUp).Row
        mn = sn.Range("B8:E" & lrn)
        For j = 1 To UBound(mn, 1)
            If Trim(mn(j, 2)) <> "" And Left(mn(j, 2), 11) <> "Steel Plate" Or Trim(mn(j, 2)) <> "" And Left(mn(j, 2), 11) <> "Chequered" Then

                If InStr(mn(j, 2), "Steel Plate") = 0 Then
                    If InStr(mn(j, 2), "Chequered") = 0 Then
            On Error GoTo thoat
            
                    k = k + 1
                    md(k, 4) = mn(j, 1)
                    md1(k, 1) = mn(j, 3)
                    End If
                End If
md(k, 11) = "VTF" & Mid(wn.Name, InStr(wn.Name, "WF") - 1, 1)
End If
thoat:
        Next j
    k = k + 1
    wn.Close False
    Next i
    
    If k > 0 Then
    
    
        For p = 1 To UBound(mn1, 1)
            For q = 1 To k
                If mn1(p, 2) = md(q, 4) Then
                    md(q, 5) = mn1(p, 8)
                    md1(q, 9) = mn1(p, 7)
                End If
            Next q
        Next p
        
 
        sd.Range("A3:M10000").Clear
        sd.Range("A3").Resize(k, 11) = md
        sd.Range("J3").Resize(k - 1, 1) = md1
        lrd = sd.Cells(Rows.Count, 8).End(xlUp).Row
        sd.Range("A3:M" & lrd).Borders.LineStyle = True
  End If
End With

        For i = 6 To lrd - 1
        If sd.Cells(i, 1) = "" Then
            sd.Range("A" & i).Resize(1, 11) = ""
            sd.Range("A" & i).Resize(1, 11).Interior.ColorIndex = 37
        End If
    Next i
    
Application.ScreenUpdating = True
End Sub