Offsetting a Range in VBA

Question

I have the following code, which copies and pastes values from one sheet to another, depending on the number of rows and columns. The code works great when copying each value one-by-one. However, the dataset that I am currently working with will always have values in rows 11 to 110 (100 values total), with only the column changing.

Hence, how can I alter the lines of code with the arrows (<--) so that it always copies rows 11 to 110, offsetting only the column number?

 Option Explicit

Sub Transpose_Lapse_LevelTrend()
Dim ws As Worksheet
Dim i, k, multiple As Integer
Dim rawrowcount As Long
Dim rawcolcount As Long
    'Define variables for the below-noted code

For i = 1 To ActiveWorkbook.Sheets.Count
    If ActiveWorkbook.Sheets(i).Name = "Q_Sheet7.1" Then
        ActiveWorkbook.Sheets(i).Delete
    End If
Next i
    'Delete Worksheet if already existing for respective tab

With ThisWorkbook
    Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    ws.Name = "Q_Sheet7.1"
    ws.Range("A1").Value = "Year"
    ws.Range("B1").Value = "Product"
    ws.Range("C1").Value = "Cashflow"
 End With

 With ThisWorkbook.Sheets("7.1")
.Range("A:A").Delete
rawrowcount = WorksheetFunction.CountA(.Range("A:A")) - WorksheetFunction.CountA(.Range("A1:A10")) - 1
rawcolcount = .Cells(10, Columns.Count).End(xlToLeft).Column - 2
 End With
     'Count the number of rows and columns to determine how many the number of iterations
'for the next set of code

Application.ScreenUpdating = False
    'Do not update screen while executing code

For i = 1 To rawcolcount
    multiple = rawrowcount * (i - 1)
    For k = 1 To rawrowcount

        'Sheets("7.1").Activate          <-- 
        'ActiveSheet.Range("A9").Select          <--
        'Selection.Offset(k + 1, 0).Select          <--
        'Selection.Copy          <--
        'Sheets("Q_Sheet7.1").Activate          <--
        'ActiveSheet.Range("A1").Select          <--
        'Selection.Offset(k + multiple, 0).Select          <--
        'ActiveSheet.Paste          <--
            'Copy and paste Years 1 to 100

        Sheets("7.1").Activate
        ActiveSheet.Range("A9").Select
        Selection.Offset(k + 1, i).Select
        Selection.Copy
        Sheets("Q_Sheet7.1").Activate
        ActiveSheet.Range("A1").Select
        Selection.Offset(k + multiple, 2).Select
        ActiveSheet.Paste
            'Copy and paste the Cashflow for Years 1 to 100 for
            'each Product

    Next k
        'Repeat for each Product Type



    Sheets("7.1").Activate
    ActiveSheet.Range("A9").Select
    Selection.Offset(2, 0).Select
    Selection.Copy
    Sheets("Q_Sheet7.1").Activate
    ActiveSheet.Range("A1").Select
    Selection.Offset(multiple + 1, 0).Select
    ActiveSheet.Paste
        'Copy & paste the Year for each respective Cashflow




    'Sheets("7.1").Activate
    'ActiveSheet.Range("B7").Select
    'Selection.Offset(0, i).Select
    'Selection.Copy
    'Sheets("Q_Sheet7.1").Activate
    'ActiveSheet.Range("A1").Select
    'Selection.Offset(multiple + 1, 1).Select
    'ActiveSheet.Paste
        'Copy & paste Region for the respective Cashflow

    Sheets("7.1").Activate
    ActiveSheet.Range("A9").Select
    Selection.Offset(1, i).Select
    Selection.Copy
    Sheets("Q_Sheet7.1").Activate
    ActiveSheet.Range("A1").Select
    Selection.Offset(multiple + 1, 1).Select
    ActiveSheet.Paste
        'Copy & paste the Product for each respective Cashflow


    'Sheets("7.1").Activate
    'ActiveSheet.Range("B8").Select
    'Selection.Offset(0, i).Select
    'Selection.Copy
    'Sheets("Q_Sheet7.1").Activate
    'ActiveSheet.Range("A1").Select
    'Selection.Offset(multiple + 1, 3).Select
    'ActiveSheet.Paste
        'Copy & paste Risk for the respective Cashflow

    ActiveSheet.Range(ActiveSheet.Cells(multiple + 2, 1), ActiveSheet.Cells(multiple + 2, 2)).Select
    Selection.AutoFill Destination:=Range(ActiveSheet.Cells(multiple + 2, 1), ActiveSheet.Cells(multiple + 101, 2))
        'Autofill the Region, Product and Product Type for each Cashflow

Next i
    'Repeat for Years 1 to 100

Application.ScreenUpdating = False
    'Do not update screen while executing code





ThisWorkbook.ActiveSheet.Cells.ClearFormats
    'Clear formatting in Output Worksheet

Set ws = Nothing

 End Sub

For every range object that needs 1 column off to the right, put `.Offset(0,1)`. e.g. `Range("A1:C3").Offset(0,1)` gives `Range("B1:D3")` — PatricK, Jan 12 '16 at 04:21

score 0 · Answer 1 · edited May 23 '17 at 11:44

What you want to do is stay away from using Select/Selection etc and rather use indexed based direct references such as Ranges. I used Select/Selection in the begining as well. Here is some data on How to avoid using Select in Excel VBA macros

I am not exactly sure as to what your script is doing with the Multiple etc, but the script below will copy the Cells 10 to 100 from Sheet 7.1 and paste the in sheet Q_Sheet7.1 in Range A1:100 it will do this for Columns 1 to 10.

I am sure you can adapt it to your script.

Sub CopyPasteUsingRange()

    Dim oRng As Range
    Dim Sht71 As Worksheet
    Dim ShtQ71 As Worksheet
    Dim rawcolcount As Long

    Set Sht71 = ActiveWorkbook.Worksheets("7.1")
    Set ShtQ71 = ActiveWorkbook.Worksheets("Q_Sheet7.1")

    'just for my example
    rawcolcount = 10

    For i = 1 To rawcolcount

        Set oRng = Range(Sht71.Cells(10, i), Sht71.Cells(110, i))

        oRng.Copy

        ShtQ71.Range(Cells(1, i), Cells(110, i)).PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone

    Next i


End Sub

Offsetting a Range in VBA

1 Answers1