Looping through rows, copy cell values to different worksheets

Question

Probably pretty straightforward - was hoping for some help. I have a 36x36 matrix that quantifies various gasoline grade relative values to other gasoline grades. I would like to write a loop that takes each row and moves it to another worksheet (in consecutive order), without having to copy and paste the same code over and over again (changing the range and sheet). Appreciate any help.

Sheets("Formulas").Range("Z8:BI8").Copy

With Sheets("CONV7.8RVP87OCT").Range("A10000").End(xlUp).Offset(1, 0)
    .PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With

Sheets("Formulas").Range("Z9:BI9").Copy

With Sheets("CONV7.8RVP89OCT").Range("A10000").End(xlUp).Offset(1, 0)
    .PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With

Sheets("Formulas").Range("Z10:BI10").Copy

With Sheets("CONV7.8RVP93OCT").Range("A10000").End(xlUp).Offset(1, 0)
    .PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With

Sheets("Formulas").Range("Z11:BI11").Copy

With Sheets("CONV9.0RVP87OCT").Range("A10000").End(xlUp).Offset(1, 0)
    .PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With

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

Sure. You just want to send the worksheet to a subroutine as a parameter.

Private sub pasteFormula(ws as WorkSheet)
    With ws.Range("A10000").End(xlUp).Offset(1, 0)
        .PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        .PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
End sub

Called like:

dim ws as WorkSheet
Set ws = Sheets("CONV7.8RVP87OCT")
Sheets("Formulas").Range("Z8:BI8").Copy
pasteFormulas(ws)
' next worksheet
Set ws = Sheets("CONV7.8RVP89OCT")
Sheets("Formulas").Range("Z9:BI9").Copy
pasteFormulas(ws)
' etc...
' You might actually want to consider a for worksheets loop, but I'll leave that as an exercise for you to complete.

See also Avoid Using Select for a pretty good description of how to use the Worksheet object as a variable.

Alex P · Answer 2 · 2014-05-18T19:14:34.033

How about this?

You'll need to define your destination sheet names e.g. "CONV9.0RVP87OCT", "CONV7.8RVP87OCT" in the array:

Sub CopyRows()
    Dim sheets() As Variant, sourceData As Range, rw As Long

    Set sourceData = Worksheets("Formulas").Range("Z8:BI43") // your 36 x 36 matrix 
    sheets = Array("Sheet2", "Sheet3") //add your sheet names in here...

    For rw = 1 To sourceData.Rows.Count
        sourceData.Rows(rw).Copy Destination:=Worksheets(sheets(rw - 1)).Range("A10000").End(xlUp).Offset(1, 0)
    Next rw
End Sub

Looping through rows, copy cell values to different worksheets

2 Answers2