使用Excel VBA将长度可变的粘贴范围从一个工作表复制到另一工作表

Question

我有设置为输出的数据，如下所示：

• 4列数据
• 然后将数据用4个空白列隔开，然后再有另外4列数据，依此类推。
• 行的长度不同
• 数据是从彭博社提取的，因此每次刷新数据时行可能都会更改。
• 数据从第3行和第2列开始。

我正在尝试创建一个循环

• 选择整个4列，将其复制并粘贴到另一个工作表中
• 然后在4个空白列之间移动，复制数据并将其粘贴到先前粘贴的数据正下方的另一个工作表中
• 直到到达包含数据的最后一列。
• 我试图在彼此之间创建一个空白行，并且在将它们粘贴到新工作表中时还试图使这4列彼此相邻

这是我遇到麻烦的代码。

Sub CopyPasteDex()

  Dim wksDest             As Worksheet
  Dim wksSource           As Worksheet
  Dim Rngsource           As Range
  Dim NextRow             As Long
  Dim LastRow             As Long
  Dim LastCol             As Long
  Dim c                   As Long

Application.ScreenUpdating = False

Set wksSource = Worksheets("Sheet1")
Set wksDest = Worksheets("Sheet2")

With wksDest
    NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

With wksSource
    LastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
    For c = 2 To LastCol Step 7
        LastRow = .Cells(.Rows.Count, c).End(xlUp).Row
        Set Rngsource = .Range(.Cells(3, c), .Cells(LastRow, c + 3))
        Rngsource.Copy
        wksDest.Range("A:A").PasteSpecial.xlPasteValues
        NextRow = NextRow + Rngsource.Rows.Count
    Next c
End With

Application.ScreenUpdating = True

End Sub

Answer 1

这似乎为我工作。

Sub CopyPasteDex()

  Dim wksDest             As Worksheet
  Dim wksSource           As Worksheet
  Dim Rngsource           As Range
  Dim NextRow             As Long
  Dim LastRow             As Long
  Dim LastCol             As Long
  Dim c                   As Long

Application.ScreenUpdating = False

Set wksSource = Worksheets("Sheet1")
Set wksDest = Worksheets("Sheet2")

With wksDest
    NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

With wksSource
    LastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
    For c = 2 To LastCol Step 8    ' make sure that the step is changed to 8 here.
        LastRow = .Cells(.Rows.Count, c).End(xlUp).Row
        Set Rngsource = .Range(.Cells(3, c), .Cells(LastRow, c + 3))
        Rngsource.copy
        wksDest.Cells(NextRow, 1).PasteSpecial xlPasteValues    ' Note that I've changed .range to .cells and changed the destination row to NextRow
        NextRow = NextRow + Rngsource.Rows.Count
    Next c
End With

Application.ScreenUpdating = True

End Sub