如何从一张表中复制列数据，然后在vba excel中将其复制到另一张表中

Question

我需要这个小项目的帮助。我需要完成以下任务：

我有一个 excel 文件，其中我的宏按钮一旦单击将仅从 A 列中的 sheet1 读取数据，然后应该将数据扔到另一个 sheet2 并将每个数据从 sheet1 移动到 sheet2 并将所有数据显示到每个单独的柱子。

这是数据示例的图像。在图像中，每个圆圈都需要在新 sheet2 的自己的列中，这只是数据的一部分，列总行数约为 900。

如果需要更多信息，请告诉我。

这是我让它将工作表从 sheet1 复制到 sheet2 的代码，但我需要其余的工作

Sub ExportFile()
Dim strValue As String
Dim strCellNum As String
Dim x As String
x = 1

For i = 1 To 700 Step 7
    strCellNum = "A" & i
    strValue = Worksheets("data").Range(strCellNum).Value
    Debug.Print strValue
    Worksheets("NewData").Range("A" & x).Value = strValue
    x = x + 1
Next
End Sub

Answer 1

试试这个：

Sub DataReorganizer()
    Dim s1 As Worksheet, s2 As Worksheet, N As Long, i As Long, j As Long, k As Long
    Dim v As Variant

    Set s1 = Sheets("Data")
    Set s2 = Sheets("NewData")

    N = s1.Cells(Rows.Count, "A").End(xlUp).Row
    For i = N To 2 Step -1
        If s1.Cells(i, "A").Value = "" And s1.Cells(i - 1, "A").Value = "" Then s1.Cells(i, "A").Delete shift:=xlUp
    Next i

    j = 1
    k = 1
    N = s1.Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To N
        v = s1.Cells(i, "A").Value
        If v = "" Then
            j = 1
            k = k + 1
        Else
            s2.Cells(j, k).Value = v
            j = j + 1
        End If
    Next i

End Sub

Answer 2

你可以试试这个：

Sub ExportFile()
    Dim area As Range
    Dim icol As Long

    With Worksheets("data")
        With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants)
            For Each area In .Areas
                icol = icol + 1
                Worksheets("NewData").Cells(1, icol).Resize(area.Rows.Count).Value = area.Value
            Next
        End With
    End With
End Sub