L oop хотя листы для добавления данных в последний ряд таблицы 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