Excel VBA-如何将列复制或移动到单行？

Question

我想通过使用宏将列复制到单行。 1-6列下的值应转到A中的下一个空行。我想使用宏进行此操作，因为我有成百上千的列要移到单行中。我确实尝试过宏录制器，但无法真正实现我想要的

我尝试了以下操作，但是它一直替换该值，而不是在其下方添加：

Sub Macro1()
Dim x As Integer
x = 2
Do While Cells(x, 3) <> ""
DoEvents
Sheet1.Cells(x, 1).End(xlUp).Offset(1, 0) = Sheet1.Cells(x, 3)
Sheet1.Cells(x, 1).End(xlUp).Offset(1, 0) = Sheet1.Cells(x, 4)
Sheet1.Cells(x, 1).End(xlUp).Offset(1, 0) = Sheet1.Cells(x, 5)
Sheet1.Cells(x, 1).End(xlUp).Offset(1, 0) = Sheet1.Cells(x, 6)
Sheet1.Cells(x, 1).End(xlUp).Offset(1, 0) = Sheet1.Cells(x, 7)
Sheet1.Cells(x, 1).End(xlUp).Offset(1, 0) = Sheet1.Cells(x, 8)
Sheet1.Range("C2:H2").Clear
Sheet1.UsedRange.Cells.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
x = x + 1
Loop
End Sub

感谢有人能对此提供帮助。

Answer 1

我建议遍历C列的各行，并在每列中找到最后使用的列，以将其值转换为A列：

Option Explicit

Public Sub CollectRows()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim LastRowA As Long
    Dim LastCol As Long

    Const FirstCol As Long = 3 'column C is the first column with data

    Dim LastRowC As Long
    LastRowC = ws.Cells(ws.Rows.Count, FirstCol).End(xlUp).Row 'find last row in col A

    Dim iRow As Long
    For iRow = 2 To LastRowC 'run from row 2 to last row in column C
        LastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'find last row in col A
        LastCol = ws.Cells(iRow, ws.Columns.Count).End(xlToLeft).Column 'find last column in current row

        'copy and transpose values
        ws.Cells(LastRowA, "A").Offset(RowOffset:=1).Resize(RowSize:=LastCol - FirstCol + 1).Value = WorksheetFunction.Transpose(ws.Cells(iRow, FirstCol).Resize(ColumnSize:=LastCol - FirstCol + 1).Value)
    Next iRow
End Sub