How can I shorten this VBA code? Copying and pasting cells

Question

A lot of the below code is duplicated for each cell I'm pasting to a new worksheet.

As an educational exercise, can anyone show me how I might shorten it?

Sub RowForTracker()

    Worksheets.Add(After:=Worksheets(1)).Name = "ForTracker"

    Sheets("Summary").Range("C2").Copy
    Sheets("ForTracker").Range("A1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("C6").Copy
    Sheets("ForTracker").Range("B1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("C8").Copy
    Sheets("ForTracker").Range("C1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("C3").Copy
    Sheets("ForTracker").Range("D1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("H8").Copy
    Sheets("ForTracker").Range("E1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("H9").Copy
    Sheets("ForTracker").Range("F1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("C5").Copy
    Sheets("ForTracker").Range("G1").PasteSpecial Paste:=xlPasteValues

End Sub

Answer 1

another additional examples how you can achieve CopyPaste

Sub test1()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    With T
        .[A1] = S.[C2]
        .[B1] = S.[C6]
        .[C1] = S.[C8]
        .[D1] = S.[C3]
        .[E1] = S.[H8]
        .[F1] = S.[H9]
        .[G1] = S.[C5]
    End With
End Sub

variant using array

Sub test2()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    Dim CopyPaste, x%
    x = 0
    With S
        CopyPaste = Array(.[C2], .[C6], .[C8], .[C3], .[H8], .[H9], .[C5])
    End With
    For Each oCell In T.[A1:G1]
        oCell.Value = CopyPaste(x): x = x + 1
    Next
End Sub

variant using split string

Sub test3()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    Dim CopyPaste$
    With S
        CopyPaste = .[C2] & "|" & .[C6] & "|" & .[C8] & "|" & .[C3] & "|" & .[H8] & "|" & .[H9] & "|" & .[C5]
    End With
    T.[A1:G1] = Split(CopyPaste, "|")
End Sub

variant using dictionary

Sub test4()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    Dim CopyPaste As Object: Set CopyPaste = CreateObject("Scripting.Dictionary")
    Dim oCell As Range, Key As Variant, x%
    x = 1
    For Each oCell In S.[C2,C6,C8,C3,H8,H9,C5]
        CopyPaste.Add x, oCell.Value: x = x + 1
    Next
    x = 0
    For Each Key In CopyPaste
        T.[A1].Offset(, x).Value = CopyPaste(Key)
        x = x + 1
    Next
End Sub

Answer 2

Well, if you want to just simplify it, you can do this:

Sub Main()

    Dim wsS As Worksheet
    Dim wsT As Worksheet

    Set wsS = Sheets("Summary")
    Set wsT = Sheets("ForTracker")

    wsT.Range("A1").Value = wsS.Range("C2").Value
    wsT.Range("B1").Value = wsS.Range("C6").Value
    wsT.Range("C1").Value = wsS.Range("C8").Value
    wsT.Range("D1").Value = wsS.Range("C3").Value
    wsT.Range("E1").Value = wsS.Range("H8").Value
    wsT.Range("F1").Value = wsS.Range("H9").Value
    wsT.Range("G1").Value = wsS.Range("C5").Value

End Sub

It may not be necessary this time, but as you said, you wished for an educational excersise, you could create a procedure just for copying cell values from one to another. It could look like this:

Sub CopyValue(CopyFrom As Range, PasteTo As Range)
    PasteTo.Value = CopyFrom.Value
End Sub

And you would call it like this:

CopyValue wsS.Range("C2"), wsT.Range("A1")

Or alternativelly, if you wanted to be extra clear, like this:

CopyValue CopyFrom:=wsS.Range("C2"), PasteTo:=wsT.Range("A1")

Answer 3

One way

Dim target As Range, item As Range, i As Long
With Worksheets.Add(After:=Worksheets(1))
    .Name = "ForTracker"
    Set target = .Range("A1")
End With

For Each item In Sheets("summary").Range("C2,C6,C8,C3,H8,H9,C5")
    target.Offset(0, i).value = item.value
    i = i + 1
Next

Answer 4

Try this:

        Sub RowForTracker()

            Dim wksSummary          As Worksheet
            Dim wksForTracker       As Worksheet

            Worksheets.Add(After:=Worksheets(1)).Name = "ForTracker"
            Set wksSummary = Sheets("Summary")
            Set wksForTracker = Sheets("ForTracker")

            With wksForTracker
                .Range("A1").Value = wksSummary.Range("C2").Value
                .Range("B1").Value = wksSummary.Range("C6").Value
                .Range("C1").Value = wksSummary.Range("C8").Value
                .Range("D1").Value = wksSummary.Range("C3").Value
                .Range("E1").Value = wksSummary.Range("H8").Value
                .Range("F1").Value = wksSummary.Range("H9").Value
                .Range("G1").Value = wksSummary.Range("C5").Value
            End With

        End Sub