How can I shorten this VBA code? Copy and paste cells

Question

A lot of the code below is duplicated for every cell that I insert in a new worksheet.

As a training exercise, can someone show me how I can 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 example of 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 

using an 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 

using split line

 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 

dictionary option

 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 just want to 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 

This time, this may not be necessary, but, as you said, you wanted to get an educational exterior, you can create a procedure for copying cell values ​​from one to another. It might 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 alternatively if you want to be clearer, for example:

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

Answer 3

One of the methods

 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 the following:

  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