使用空单元格作为参数复制一系列单元格 – > PasteSpecial New Worksheet

我的数据全部在一列，并向下增长。 只有几行数据，然后是空格（空格的数量有所不同）。

我试图select每组数据，并将其自动转置到下一个可用行中的下一个表单上，并继续，直到列中没有更多数据。

请原谅我对下面的无知，我从几个小时的search和search这个网站拼凑起来。

这是我到目前为止，这种工作…但我想我需要另一个整数被定义，所以我可以得到一个范围来复制，像

Sheets("Sheet1").Range(A & I “:” A & X ).Copy 

然后，粘贴一个类似的操作：

 Sheets("Sheet2").End(xlUp).Row.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True 

完整的macros我正在与：

 Sub PadOut() Application.ScreenUpdating = False Dim i As Integer, j As Integer j = 1 'loops from 1 to the last filled cell in column 1 or "A" For i = 1 To Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row 'checks if the cell has anything in it If IsEmpty(Sheets("Sheet1").Range("A" & i)) = False Then 'this is where the copying and pasting happens (well basically) Sheets("Sheet1").Range(A & i).copy Sheets("Sheet2").End(xlUp).Row).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True j = j + 1 End If Next i Application.ScreenUpdating = True End Sub 

Answer 1

在这里，我定义一个Source范围，然后使用Range的SpecialCells方法将Source分解为区域。 接下来，我遍历源范围的区域并将它们转置到Sheet2上的下一个空单元格。

 Sub PadOut() Application.ScreenUpdating = False Dim Source As Range, Target As Range Dim i As Long With Sheets("Sheet1") On Error Resume Next Set Source = .Range("A1", .Range("A" & Rows.Count).End(xlUp)) Set Source = Source.SpecialCells(xlCellTypeConstants) On Error GoTo 0 End With If Not Source Is Nothing Then With Sheets("Sheet2") For i = 1 To Source.Areas.Count Source.Areas(i).Copy Set Target = .Range("A" & Rows.Count).End(xlUp) If Target.Value = "" Then Target.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True Else Target.Offset(1).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True End If Next End With End If Application.ScreenUpdating = True End Sub 

Answer 2

代码将是这样的。

 Sub PadOut() Application.ScreenUpdating = False Dim i As Long Dim n As Long n = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 'loops from 1 to the last filled cell in column 1 or "A" For i = 1 To n 'checks if the cell has anything in it If IsEmpty(Sheets("Sheet1").Range("A" & i)) = False Then 'this is where the copying and pasting happens (well basically) Sheets("Sheet1").Range("A" & i).Copy Sheets("Sheet2").Range("a" & Rows.Count).End(xlUp)(2) End If Next i Application.ScreenUpdating = True End Sub 

Answer 3

跳过空白单元格的函数在你的情况下将会很有用：

 Function SkipBlanks(start As Range) As Long Dim r, c As Long r = start.Row c = start.Column 'we make sure, that we won't exceed the number of rows Do While IsEmpty(Cells(r, c)) And r < Rows.Count r = r + 1 Loop SkipBlanks = r End Function 

它以单元格为参数，查找下一个非空单元格。 如果给定的单元格不为空，它将返回它的行，如果它是空的，函数将返回下一个非空单元格的行。 使用这个函数，我们可以写如下：

 Sub s() Dim startingRow, i, j As Long j = 3 i = 1 'we will through all rows Do While i < Rows.Count 'we skip blanks startingRow = SkipBlanks(Cells(i, 1)) i = startingRow Do While Not IsEmpty(Cells(i, 1)) Cells(i - startingRow + 1, j).Value = Cells(i, 1).Value i = i + 1 Loop 'we move to next column (here you can place code, which will choose next sheet to use j = j + 1 Loop End Sub 

这个子程序取第一个数据块，把它放在C列中，然后跳到空白，直到下一个数据块，并把它放在D列等。而不是去另一列，你可以去另一个表。