Excel VBA Code pastes result into wrong range - excel

Question

A script that copies a range into another range. However, when I try to copy the range from Sheet1 to Sheet2 the result won't be pasted into column J, it get pasted with an offset of 8 columns (column R). I cant understand why? Both RowCountSummary and ColumnCountSummary are set to 0, i.e. first index of the range?
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

This behaviour has been encountered before and can seen with this simple demo
Sub test()
With Sheet1.Range("J3:J100")
Debug.Print .Range(.Cells(0, 0), .Cells(47, 0)).Address
End With
End Sub
which results in $R$4:$R$51. If you repeat run for the columns B to J the results are B,D,F,H,J,L,N,P showing the doubling effect. B is OK I think because of the zero column number.
You can probably fix your code by setting RowCountSummary = 1 and ColumnCountSummary = 1 and adding .parent
With PasteRange
.Parent.Range(.Cells(RowCountSummary, ColumnCountSummary), _
.Cells(RowCountSummary + RowsCount2, ColumnCountSummary)).PasteSpecial
End With
or you could try this
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
See Remarks section the docs