如何从一个工作表复制列数据,然后将其复制到vba excel中的另一个工作表

时间:2017-03-30 16:44:56

标签: vba excel-vba excel

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

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

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

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

enter image description here

这是我将它从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

2 个答案:

答案 0 :(得分:0)

你可以试试这个:

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

答案 1 :(得分:0)

尝试一下:

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
相关问题