VBA - 将列复制并粘贴到单个列和然后复制相应的标题x次

时间:2016-06-08 08:23:04

标签: excel vba loops

我的VBA技能很新鲜,因为这是我一直在努力改进的。

我已经搜索并获得了编码的一些部分,但是,我不能做我需要的。 (每个条形代表excel表格上的单元格

我知道这并不复杂,但是当我需要根据每个标题的行数来计算,复制和粘贴标题时,我很挣扎。

问候。

1 个答案:

答案 0 :(得分:1)

假设您的数据位于Sheet1,并且您希望结果为Sheet2,请尝试以下代码:

Sub RangetoColumn()
    Dim lastRow As Long, lastColumn As Long
    Dim CurrentSheet As Worksheet, TargetSheet As Worksheet
    Dim i As Long, j As Long, Count As Long
    Dim colHeader As String

    Set CurrentSheet = ThisWorkbook.Worksheets("Sheet1")    '-->sheet with data
    Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")     '-->sheet to display result
    lastColumn = CurrentSheet.Cells(1, Columns.Count).End(xlToLeft).Column

    Count = 1
    For i = 1 To lastColumn
        lastRow = CurrentSheet.Cells(Rows.Count, i).End(xlUp).Row
        If lastRow > 1 Then    '-->check for data below header
            colHeader = CurrentSheet.Cells(1, i).Value
            For j = 1 To lastRow - 1
                TargetSheet.Range("A" & Count).Value = colHeader
                TargetSheet.Range("B" & Count).Value = CurrentSheet.Cells(j + 1, i).Value
                Count = Count + 1
            Next j
        End If
    Next i
End Sub