使用 VBA 将数据从 sheet1 转到 sheet2答案

【问题标题】：Turning around data from sheet1 to sheet2 using VBA使用 VBA 将数据从 sheet1 转到 sheet2
【发布时间】：2016-07-25 12:03:02
【问题描述】：

我在互联网上四处寻找我的问题的答案。我需要能够在 Excel 中将数据从 sheet1 复制到 sheet2，但是行应该变成列。

在 sheet1 中，我在 A 列中列出了标题、范围和截止日期，在 B 列中列出了提供给这些标题的数据。在 sheet2 中，我想单击一个命令按钮，它分别为我提供 A1、B1 和 C1 中的标题、范围和截止日期以及这些标题下方的数据。执行此操作时，当在 sheet2 中列出标题时，代码应该在 sheet1 中每隔四行选取一次，依此类推。

我试了一下，放不出来。我的想法是使用某种循环。

Private sub CommandButton1_Click()
    shSource=WorkSheets("Sheet1")
    shDest=WorkSheets("Sheet2")
    LastRow = shSource.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LastRow
        Range("A1").Offset(4, 0).Select
        Selection.Copy
        shDest.Select
        shDest.Range("A1").Select
        If shDest.Range("A1").Offset(1, 0) <> "" Then
            shDest.Range("A1").End(xlDown).Select
        End If
        ActiveCell.Offset(1, 0).Select
        ActiveCell.Paste
    Next i
End Sub

Source sheet1

Destination Sheet2

我真的希望你们中的一些人可以帮助我。谢谢，米歇尔

【问题讨论】：

粘贴时使用 PasteSpecial Transpose 看这个 -> stackoverflow.com/questions/8852717/…
欢迎来到 Stackoverflow。请您粘贴您的 Sheet1 和 Sheet2 的示例。我对“每四行”部分有点困惑。正如@newguy 提到的，您可以使用.PasteSpecial Transpose:=True 将列粘贴到行中，反之亦然
我已经发布到我的工作表截图
我格式化了您的代码（您应该这样做以使其对我们可读！），这表明缺少 Next i。

标签： vba loops copy offset

【解决方案1】：

你可以试试这样的：

Sub moveData()

    Set sourceSheet = Worksheets("Sheet1")
    Set targetSheet = Worksheets("Sheet2")

    lastRow = sourceSheet.Cells(1, 1).End(xlDown).Row ' assume your data starts are A1 cell
    lastColumn = sourceSheet.Cells(1, 1).End(xlToRight).Column

    For columnCounter = 1 To lastColumn
        For rowCounter = 1 To lastRow
            targetSheet.Cells(columnCounter, rowCounter) = sourceSheet.Cells(rowCounter, columnCounter)
        Next
    Next

End Sub

它是transponse功能的替代品，希望您可以根据需要进行更改。

【讨论】：

如果您在适应您的情况时遇到问题，请告诉我。

【解决方案2】：

不完美，但应该可以 -

  Sub test()

    Dim rngSource As Range
    Dim rngTarget As Range

    Set rngSource = Sheets("Sheet1").Range("B2")
    Set rngTarget = Sheets("Sheet2").Range("A2")

    Dim strArr() As String
    ReDim strArr(0 To 4, 0 To 0)
    Dim i As Integer
    i = 0
    Do While rngSource.Value <> ""
        With rngSource
            strArr(0, i) = .Offset(0, 0).Value
            strArr(1, i) = .Offset(1, 0).Value
            strArr(2, i) = .Offset(2, 0).Value
            strArr(3, i) = .Offset(0, 1).Value
            strArr(4, i) = .Offset(0, 2).Value
        End With
        i = i + 1
        Set rngSource = rngSource.Offset(4, 0)
        ReDim Preserve strArr(4, i)

    Loop

    Range(rngTarget, rngTarget.Offset(i, 4)).Value = _
            Application.WorksheetFunction.Transpose(strArr)

End Sub

【讨论】：