循环遍历工作表以将数据添加到表VBA的最后一行

Question

我正在研究一种将数据从多个工作表复制到单个工作表并将其附加到表的解决方案。 。我有代码可以工作，除了将数据复制到srcWs的底部时，它不采用当前形式。我必须使用UsedRange，因为来自actShtNames的数据中存在空白，可能总计几个空白行。

Dim srcWB As Workbook
Dim srcWs As Worksheet
Dim shtCount As Integer
Dim actShtName As String
Dim lRow As Long
Dim cEndRow As Long
Dim txt As Range
Dim tbl As ListObject

  'Set the SCR workbook and worksheet
   Set srcWB = Workbooks.Open("\\***")
   MsgBox (srcWB.Name)
   Set srcWs = srcWB.Worksheets("R_Data")
   srcWs.Activate

   'Get the current last row of the table of the srcWs
   cEndRow = Range("A" & Rows.Count).End(xlUp).Row
   'MsgBox (cEndRow)

    Set tbl = srcWs.ListObjects("Table1")   
   'For sheets that start at index after sheets 1-5 to end of workbook.

    For shtCount = Worksheets("1-5").Index + 1 To Worksheets.Count

    Sheets(shtCount).Activate
    actShtName = ActiveSheet.Name

      If actShtName = "R_Data" Or actShtName = "Warehouse_Data" Or actShtName = "Sheet2" Then
     'If Sheet is R Data then ignore the sheet. That is the src worksheet that houses data
     'Also ignore Warehouse data and sheet2
        Else
            'MsgBox (actShtName)
            If Worksheets(actShtName).UsedRange.Count > 1 Then
                lRow = srcWs.Range("A" & Rows.Count).End(xlUp).Row
                'MsgBox (lRow)
                With Worksheets(actShtName).UsedRange
                srcWs.Cells(lRow + 1, 1).Resize(.Rows.Count, _
                .Columns.Count).Value = .Value
            End With
            End If
        End If

     Next shtCount

   'Delete any duplicate headrs that are copied over
      For Each txt In srcWs.Range("A2:A" & lRow)
         If txt.Value = "Supply Name" Then
             txt.EntireRow.Delete
         End If
      Next txt