Excel VBA 代碼將結果粘貼到錯誤的范圍內

Question

將一個范圍復制到另一個范圍的腳本。 但是，當我嘗試將范圍從 Sheet1 復制到 Sheet2 時，結果不會粘貼到 J 列中，而是以 8 列（R 列）的偏移量粘貼。 我不明白為什么？ RowCountSummary 和 ColumnCountSummary 都設置為 0，即范圍的第一個索引？

Sub InsertForecastData()

  Dim ColumnsCount As Integer
  Dim ColCounter As Integer
  Dim RowsCount As Integer
  Dim ForeCastRange As Range
  Dim ForecastWS As Worksheet
  Dim SummaryWs As Worksheet
  Dim PasteRange As Range
  Dim ColumnCountSummary As Integer
  Dim RowCountSummary As Integer

  ColumnsCount = 300
  ColCounter = 0
  RowsCount1 = 0
  RowsCount2 = 47
  ColumnCountSummary = 0
  RowCountSummary = 0

  Do While ColCounter <= ColumnsCount

  Worksheets("Sheet1").Select
  Set ForeCastRange = Worksheets("Sheet1").Range("B2:KN49")
  With ForeCastRange
    .Range(.Cells(RowsCount1, ColCounter), .Cells(RowsCount2, ColCounter)).Copy
  End With

  Worksheets("Sheet2").Select
  Set PasteRange = Worksheets("Sheet2").Range("J2:J13915")
  With PasteRange
    .Range(.Cells(RowCountSummary, ColumnCountSummary), .Cells(RowCountSummary + RowsCount2, ColumnCountSummary)).PasteSpecial
  End With

  RowCountSummary = RowCountSummary + 48
  ColCounter = ColCounter + 1

  Loop

End Sub 

Answer 1

這種行為以前遇到過，可以通過這個簡單的演示看到

Sub test()
  With Sheet1.Range("J3:J100")
    Debug.Print .Range(.Cells(0, 0), .Cells(47, 0)).Address
  End With
End Sub

結果是 $R$4:$R$51。 如果對 B 到 J 列重復運行，則結果為 B、D、F、H、J、L、N、P，顯示了加倍效果。 B 可以，因為列號為零。

您可以通過設置 RowCountSummary = 1 和 ColumnCountSummary = 1 並添加 .parent 來修復您的代碼

With PasteRange
  .Parent.Range(.Cells(RowCountSummary, ColumnCountSummary), _
  .Cells(RowCountSummary + RowsCount2, ColumnCountSummary)).PasteSpecial

結束於

或者你可以試試這個

Sub InsertForecastData1()

  Const columnCount As Integer = 3
  Const rowCount As Integer = 48
  Const sourceCol As String = "B"
  Const targetCol As String = "J"
  Const startRow As Integer = 2
  Const records As Integer = 300

  Dim rngSource as Range, rngTarget As Range
  Dim start as Single, finish as Single
  Set rngSource = Worksheets("Sheet1").Range(sourceCol & startRow)
  Set rngSource = rngSource.Resize(rowCount, columnCount)
  Set rngTarget = Worksheets("Sheet2").Range(targetCol & startRow)

  start = Timer
  Application.ScreenUpdating = False

  Dim i As Integer
  For i = 1 To records
    'Debug.Print rngSource.Address, rngTarget.Address
    rngSource.Copy rngTarget
    Set rngSource = rngSource.Offset(rowCount, 0)
    Set rngTarget = rngTarget.Offset(rowCount, 0)
  Next i

  Application.ScreenUpdating = True
  finish = Timer
  MsgBox "Completed " & records & " records in " & finish - start & " secs"

End Sub

請參閱文檔的備注部分