Question

如果存在值，我目前正将sheet1中table1（名为sheet1）的数据移动到sheet2中的table2（名为sheet2）。我是List对象的新手，我不确定如何解决这个问题。第1页将包含大量数据，而第2页将首先是空表。我计划迭代数据，并将数据复制过来，如果它有值。

'e will be coming from an array I have set up. 
e = "Sheet1"

Sub GatherData(ByVal e As String)
Dim Lo As ListObject, Ros As ListRows, e2 as String
Dim Tablesize As Integer, CurrentRow As Integer
Dim Sht1 As Worksheet
Set Sht1 = ActiveWorkbook.Worksheets(e)
Set Lo = Sht1.ListObjects(e)
Set Ros = Lo.ListRows
Tablesize = Ros.Count

e2 = "sheet2"
Dim Sht2 As Worksheet
Set Sht2 = Worksheets(e2)
Set Lo2 = Sht2.ListObjects(e2)
Set Ros2 = Lo2.ListRows
Tablesize2 = Ros2.Count


    For CurrentRow = 1 To Tablesize
        If Lo.ListColumns("Name").DataBodyRange(CurrentRow) <> "" Then
        'nesting if loop when I add further functionality to check for further values in other columns            
               If Lo.ListColumns("Name_Value").DataBodyRange(CurrentRow) <> "" Then
               'add to new table on sheet 2
                'Lo2.ListRows.Add
                'sht1.Range("A" & CurrentRow).Copy sht2.Range("A" & Tablesize2)
                'sht1.Range("A" & CurrentRow).Copy sht2.Range("B" & Tablesize2)
                'sht1.Range("B" & CurrentRow).Copy sht2.Range("C" & Tablesize2)
                End If    
        End If

    Next CurrentRow

    How the table is set up for ex;

    Sheet 1                     Sheet 2
    Name   Value           Tablename  Name   Value

Answer 1

Dim e As String
e = "Sheet1"

Dim Lo As ListObject, Ros As ListRows, e2 As String
Dim Tablesize As Integer, CurrentRow As Integer
Dim Sht1 As Worksheet
Set Sht1 = ThisWorkbook.Worksheets(e) ''Edited this line for best practice
Set Lo = Sht1.ListObjects(e)
Set Ros = Lo.ListRows
Tablesize = Ros.Count

e2 = "sheet2"
Dim Sht2 As Worksheet
Dim Lo2 As ListObject, Ros2 As ListRows, Tablesize2 As Integer ''These variables were not dimensioned
Set Sht2 = ThisWorkbook.Worksheets(e2) ''EDITED THIS LINE!!
Set Lo2 = Sht2.ListObjects(e2)
Set Ros2 = Lo2.ListRows

On Error Resume Next
Tablesize2 = Lo2.DataBodyRange.Rows.Count ''if no data rows error 91 is thrown
If Err.Number = 91 Then
    Tablesize2 = 0
ElseIf Err Then
    MsgBox ("An error has occurred, Error Number = " & Err.Number & " The Action is Cancelled")
    ''add other code to roll back changes
    Exit Sub  
End If

    For CurrentRow = 1 To Tablesize
        If Lo.ListColumns("Name").DataBodyRange(CurrentRow) <> "" Then
        'nesting if loop when I add further functionality to check for further values in other columns
               If Lo.ListColumns("Value").DataBodyRange(CurrentRow) <> "" Then ''EDITED THIS LINE!!
               'add to new table on sheet 2
                Lo2.ListRows.Add
                Tablesize2 = Lo2.DataBodyRange.Rows.Count      ''ADDED THIS LINE

                Lo2.DataBodyRange.Cells(Tablesize2, 1) = Lo.Name
                Sht1.Range("A" & CurrentRow + 1).Copy (Lo2.DataBodyRange.Cells(Tablesize2, 2))
                Sht1.Range("B" & CurrentRow + 1).Copy (Lo2.DataBodyRange.Cells(Tablesize2, 3))(xlPasteValues) ''ADDED LINE
                End If
        End If

    Next CurrentRow

Tablesize2 = Ros2.Count创建一个条件，表中没有数据，表中数量为0或没有数据，计数为1，为了避免这个问题，我改为{{1}如果没有数据则抛出错误;如果有1行或更多行数据，则抛出数据行的计数。

请注意，您可以执行此操作，而不是复制和粘贴：

DatabodyRange.Rows.Count

使用VBA将数据从一个表移动到另一个表

1 个答案: