Excel VBA Code вставляет результат в неправильный диапазон

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

См. Примечания в разделе документы