excel - 将列排序为八个单元格的行

Question

不知道能不能实现我需要从 B 列的工作表 2 中复制具有可变范围的数据，从工作表 2 中一次选择 8 行，从第 9 行开始在工作表 1 中换位粘贴？谢谢

Sub copy()
Sheets(2).Range("B1:B8").Copy
With Sheets(1).Range("B9:I9")
    .PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
Sheets(2).Range("B9:B16").Copy
With Sheets(1).Range("B10:I10")
    .PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
Sheets(2).Range("B17:B24").Copy
With Sheets(1).Range("B11:I11")
    .PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
Sheets(2).Range("B25:B32").Copy
With Sheets(1).Range("B12:I12")
    .PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With


Application.CutCopyMode = True
 End Sub  ```

Answer 1

代码假设我们要复制和粘贴的范围始终相同且始终为 8 行。

我假设原始数据如下所示:

然后我们可以复制范围并将其转置为:

通过使用此代码:

Sub Copy_paste_transpose()

Dim lrow_copy As Long
Dim i As Long, j As Long
Dim rows_to_copy As Long

lrow_copy = Sheets(2).Cells(Rows.Count, "B").End(xlUp).Row 'Find last row in Sheet2

i = 9 'Start pasting at row 9
rows_to_copy = 7 'always "remove" one row.

For j = 1 To lrow_copy Step 8 'Loop through range and "jump" 8 rows at each looping.
    Sheets(2).Range(Sheets(2).Cells(j, "B"), Sheets(2).Cells(j + rows_to_copy, "B")).Copy 'Copy range
    Sheets(1).Range(Sheets(1).Cells(i, 2), Sheets(1).Cells(i, 2 + rows_to_copy)).PasteSpecial Paste:=xlPasteValues, Transpose:=True 'Paste range and transpose the copied range
    
    i = i + 1 'add one row after each paste

Next j

Application.CutCopyMode = False 'Deselect last copy selection

End Sub