使用具有连续列的VBA将列从1张表的行转换为另一张表

Question

我有一个用于跟踪项目的不断更新的电子表格，但我想为内部利益相关者创建摘要视图。我希望将列转换为从“任务”工作表到“评估更改”工作表的行。

我试图记录一个宏，这就是我记录的内容：

INDIRECT("B1:A")

错误消息显示：运行时错误'1004'：此选择无效。确保复制和粘贴区域不重叠，除非它们的大小和形状相同。

我目前拥有的（新项目被添加到新列中，因此新项目将进入第一列）：

我想要的是将第2-10行像这样转置到“评估更改”工作表中，因此新列将转置到新行：

因此，在上面的示例中，当我在“任务”表中添加新项目时，该项目即被添加到列I。但是，当我运行已记录的宏时，错误消息会弹出并且不会复制任何新的行列。

。

我当时正在考虑添加一个按钮并为其分配VBA，以便每次单击该按钮时，它将使用新列进行更新并再次转置。但是我不知道该怎么做。我刚接触VBA，因此非常感谢您的帮助。

Answer 1

这是找到要复制的最后一列的一种方法：

Dim lastCol As Long

With Sheets("Tasks")
    'find the last used column on row 3
    lastCol = .Cells(.Columns.Count, 3).End(xlToLeft).Column
    .Range(.Range("B3"), .Cells(14, lastCol)).Copy
End With

'paste and translose
Sheets("Assessment Changes").Range("B3").PasteSpecial Paste:=xlPasteAll, _
              Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Answer 2

根据您的屏幕截图，您可以尝试以下操作：

With Sheets("Tasks").UsedRange
    .Resize(.Rows.Count - 1, .Columns.Count - 2).Offset(1, 2).Copy
End With

Sheets("Assessment Changes").Range("A6").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Answer 3

我根据上述反馈和一些谷歌搜索帮助对此进行了尝试，并且效果很好：

Sub Transpose_columns_to_rows()
  Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, j As Long
  Set sh1 = Sheets("Tasks")  'origin
  Set sh2 = Sheets("Assessment Changes")  'destiny
  sh2.Range("A6", sh2.Cells(Rows.Count, Columns.Count)).ClearContents
  lr = 6
  For j = 3 To sh1.Cells(2, Columns.Count).End(xlToLeft).Column
    sh2.Range("A" & lr).Resize(1, 10).Value = Application.Transpose(sh1.Cells(2, j).Resize(10).Value)
    lr = lr + 1
  Next
End Sub

非常感谢您的帮助！