CODEWITHSUNDEEP
excelvba
Energizer1
Energizer1

Reputation: 295

Excel VBA Code pastes result into wrong range

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

Upvotes: 0

Views: 362

Answers (1)

CDP1802
CDP1802

Reputation: 16357

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

Upvotes: 1

Related Questions