在sheet2中创build列取决于excel中sheet1中的行数

我想在sheet2中创build列取决于excel中sheet1中的行数。 例如我有sheet1中的数据

ROW1:rowvalue1 ROW2:rowvalue2 ROW3:rowvalue3 

我想在sheet2中有

 column1 column2 column3 rowvalue1 rowvalue2 rowvalue3 

Answer 1

使用复制和粘贴特殊的“转置” – 你可以手动做到这一点。

如果你想使用VBA：

 Sub Macro1() Sheets(1).Activate 'open the first sheet Sheets(1).Range("A1:A" & Sheets(1).Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row).Select 'select all values in column Selection.Copy Sheets(2).Select ActiveSheet.Range("A1").Select 'this is where your data will be pasted Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True 'transpose=true flips your data around End Sub 

如果表单（1）是指第一张表单，表单（2）是第二个表单，则可以用表单的索引或名称replace这些表单（如果使用名称，则在其周围使用引号），并假设您的数据在A1开始，代码：

  Sheets(1).Range("A1:A" & Sheets(1).Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row).Select 

select所有的数据到该列中的最后一个单元格。

为了使这个工作在多个列上，如果他们全都连续，你可以转置整个块。 例如：Sub Macro1（）

  Sheets(1).Activate 'open the first sheet Sheets(1).Range("A1:X" & Sheets(1).Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row).Select 'select all values in column Selection.Copy Sheets(2).Select ActiveSheet.Range("A1").Select 'this is where your data will be pasted Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True 'transpose=true flips your data around End Sub 

如果你只想做一些行列，那么你需要在原始代码上创build一个循环。

 Sub Macro1() y = Array(1, 3, 5, 9) 'this is the index of columns A,C,E,F For x = 0 To 3 Sheets(1).Activate 'open the first sheet RowCount = Sheets(1).Range(Cells(ActiveSheet.Rows.Count, y(x)).End(xlUp), Cells(ActiveSheet.Rows.Count, y(x)).End(xlUp)).Row Sheets(1).Range(Cells(1, y(x)), Cells(RowCount, y(x))).Select 'select all values in column Selection.Copy Sheets(2).Activate ActiveSheet.Range(Cells(x + 1, 1), Cells(x + 1, 1)).Select 'this is where your data will be pasted Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True 'transpose=true flips your data around Next End Sub 

Answer 2

尝试下面的代码

 Sub PerformAction() Application.ScreenUpdating = False With Worksheets(Sheet1.Name) LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row End With For i = 1 To LastRow Sheet2.Cells(1, i).Value = Sheet1.Range("A" & i).Value Next Application.ScreenUpdating = True End Sub