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

Question

我的数据设置为输出如下：

4列数据
然后数据由 4 个空白列分隔，然后还有另外 4 列数据等
行的长度不同
数据是从 Bloomberg 中提取的，因此每次刷新数据时行可能会发生变化。
数据从第 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

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

Copy Pasting Range of varying length from one worksheet to another worksheet using Excel VBA

excel

vba

loops

copy-paste

range