获取错误 400 循环遍历工作表以获取数据

Question

我试图遍历我的 89 个工作表并提取一些数据来合并它们。 我想跳过工作表“global”和“34”。 我想获取 A 列到 M 列的数据，第 1 行除外。我想获取那些数据（不在表中）并将它们放在同一个位置（在我的代码中，我试图将它们放在表中，但它是可选的.

我收到错误 400。有什么建议吗？

Sub data()

Dim ws As Worksheet
Dim count As Long
Dim x As Long

Set tblref = Sheets("Global").ListObjects("ref_global")

For Each ws In ThisWorkbook.Worksheets
    If Not ws.Name = "Global" Then
        If Not ws.Name = "34" Then
    
            numrows = ws.Range("A1", ws.Range("A1").End(xlDown)).Rows.count
            ws.Range("a2").Select
     
            For x = 2 To numrows
                ws.Range("cells(x,1):cells(x,14)").Select
                Selection.Copy
                
                Dim lrow As ListRow
                Set lrow = tblref.ListRows.Add
            
                With lrow
                    .PasteSpecial

                End With
            Next x
        End If
    End If
Next ws
End Sub

Answer 1

您不能在非活动工作表上使用范围的 Select 方法。 您的代码中还有其他几个错误（例如： ws.Range("cells(x,1):cells(x,14)").Select不正确），并且您不需要 select 或激活任何范围/工作表来执行此操作。 像这样的事情可能更接近你想要实现的目标：

Sub data()

    Dim ws As Worksheet, tblRef As Variant, numrows As Long
    Dim count As Long
    Dim x As Long
    
    Set tblRef = Sheets("Global").ListObjects("ref_global")
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Global" And ws.Name <> "34" Then
        
                Dim lrow As ListRow
                numrows = ws.Range("A1", ws.Range("A1").End(xlDown)).Rows.count
                For x = 2 To numrows
                    Set lrow = tblRef.ListRows.Add
                    lrow.Range.Value = ws.Range(ws.Cells(x, 1), ws.Cells(x, 14)).Value
                Next x
        End If
    Next ws
End Sub

Answer 2

合并数据

Option Explicit

Sub ConsolidateData()

    Const sFirstCellAddress As String = "A1"
    Const sColumnsCount As Long = 14
    
    Const dName As String = "Global"
    Const dtblName As String = "ref_global"
    Const eName As String = "34"
    
    Dim dtbl As ListObject
    Set dtbl = ThisWorkbook.Worksheets(dName).ListObjects(dtblName)
    Dim dCell As Range: Set dCell = dtbl.Range.Offset(dtbl.Range.Rows.Count)

    Application.ScreenUpdating = False
    
    Dim sws As Worksheet
    Dim srg As Range
    Dim srCount As Long
    
    For Each sws In ThisWorkbook.Worksheets
        If StrComp(sws.Name, dName, vbTextCompare) <> 0 Then
            If StrComp(sws.Name, eName, vbTextCompare) <> 0 Then
                Set srg = sws.Range(sFirstCellAddress).CurrentRegion
                srCount = srg.Rows.count - 1
                If srCount > 0 Then
                    Set srg = srg.Resize(srCount, sColumnsCount).Offset(1)
                    dCell.Resize(srCount, sColumnsCount).Value = srg.Value
                    Set dCell = dCell.Offset(srCount)
                End If
            End If
        End If
    Next sws

    Application.ScreenUpdating = True
                   
    MsgBox "Data consolidated.", vbInformation

End Sub