快速和简单的方法来获得粘贴特殊：

sourceSheet.Range("A" & i & ":L" & i).Copy 
targetSheet.Range("B" & targetRow & ":M" & targetRow).PasteSpecial xlPasteValues

但你也可以用途：

targetSheet.Range("B" & targetRow & ":M" & targetRow).Value = sourceSheet.Range("A" & i & ":L" & i).Value

更快的方法是使用数组，这样你就不会逐行添加：

Sub ConsolidateData()
    
    Const COL_AMT = 13 'amount of col A-M
    Dim sourcePath As String
    Dim folderName As Variant
    Dim sourceFile As String
    Dim SourceBook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastrow As Long
    Dim lRowT As Long
    Dim i As Long, j As Long, rCount As Long
    Dim arr(), arrT()

    'Set the path to the source Directory
    sourcePath = "C:\Windows\Blackstone\Software\Box\Internal Control\L1 & L2 Review Project\Checklist"

    'Set the target sheet
    Set targetSheet = ThisWorkbook.Worksheets("Overview")

    'Copy Column headers to target sheet if it's empty
    If Application.CountA(targetSheet.Range("A1:XFD1")) = 0 Then
        targetSheet.Range("A1:XFD1").Value = Array("Tab Name", "Activity", "SOP Status", "CQ Quarter Transition", "Quarter of Transition", "Source Systems", "Exclusions/Exceptions", "Comments", "Criticality", "Time spent L1 (mins)", "Est. Time Spent L2 (mins)", "L2 Applicable")
    End If

    'Loop through each folder in the source directory
    For Each folderName In Array("Asia Business Finance", "Asia Finance I PM", "BEPIF FPA", "BPP Finance", "BREDS AM", "BREDS Loan Ops", "BREIT FP&A and PM", "BREP Finance", "Common Activities", "EMEA PM", "Europe PM", "US PM")
        'set the path to the source folder
        sourcePath = "C:\Windows\Blackstone\Software\Box\Internal Control\L1 & L2 Review Project\Checklist\Chicklist2\" & folderName & "\"

        'Loop through each file in the source folder
        sourceFile = Dir(sourcePath & "*.xlsx")
        Do While sourceFile <> ""
            'Open the sourceWorkbook
            Set SourceBook = Workbooks.Open(sourcePath & sourceFile)

            'set the source sheet
            Set sourceSheet = SourceBook.Worksheets("Overview")

            'Find the last row in the source sheet
            lastrow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
            lRowT = targetSheet.Range("A" & targetSheet.Rows.Count).End(xlUp).Row 'get the lRow of the targetSheet once per loop
            arr = sourceSheet.Range("A2:L" & lastrow).Value 'place all needed data in array
            ReDim arrT(1 To UBound(arr, 1), 1 To COL_AMT) '
            'loop through each row in the source sheet
            For i = 1 To lastrow - 1 'arr starts at 1
    
                'Check if the row meets the criteria for copying
                If arr(i, 1) <> "" Then
                    rCount = rCount + 1
                    arrT(rCount, 1) = folderName
                    For j = 2 To COL_AMT
                        arrT(rCount, j) = arr(i, j - 1)
                    Next j
                End If
            Next i
            targetSheet.Range("A" & lRowT).Offset(1).Resize(rCount, COL_AMT).Value = arrT 'get the needed rows in your targetsheet in one go
            'Close the sourceWorkbook
            SourceBook.Close

            'Get the next file in the directory
            sourceFile = Dir
        Loop
    Next folderName

    'Save the target workbook
    ThisWorkbook.Save

End Sub

(don别忘了我确实编辑/添加了一些变量）希望对你有效：）