Copy/Paste a column into a single cell in a different sheet, then Copy/Paste the results into another sheet

[m5edward]

Hello All,

I am looking for help to fix a macro, or build a new one.

Goal: To create a looping macro which will copy/paste a column of store numbers into into a single cell in another sheet (on a 1 by 1 basis) and then paste 2 sets of returned results into the original sheet. The two sheets are called 'Summary' and 'Margin Model 1'.

Example:


Sheet 1 named 'Summary' - This is the first sheet. The store # (A2) will be copied into cell A1 in the second sheet. The price and margin data present here comes from the second sheet named 'Margin Model 1'.

Store #	Province	2017 Price	2018 Price	2017 Margin	2018 Margin
1	ON	5	7	1	2
2	AB
3	ON
4	BC
5	ON

<tbody>
</tbody>

Sheet 2 named 'Margin Model 1' - This is the second sheet with the data to be copied into the first sheet. When cell A1 is changed, VLookups retrieve the Price and Margin data.

1	2017	2018
Price	5	7
Margin	1	2

<tbody>
</tbody>

Existing Code: Very wrong - ignore the cell numbers, very different in real life

Sub Copy_test()
Sheets("Summary").Select
Range("E3:E69").Select


Sheets("Margin Model 1").Select
Range("c1").Select


Do Until ActiveCell = ""
ActiveCell.Copy
Sheets("Summary").Select
Range("a3:a69").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("c1").Select
Range("j6:k6").Copy
Sheets("Summary").Select
Range("c3:d69").Select

Range("j10:k10").Copy
Sheets("Summary").Select
Range("e3:f69").Select

ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(3, 0).Select

Sheets("Summary").Select
ActiveCell.Offset(1, 0).Select


Loop

Sheets("Model").Select
Range("A1").Select


End Sub



Any help would be greatly appreciated. Please and thank you.

 

[Fluff]

Does this do what you want?

Sub Copy_test()

    Dim Ws As Worksheet
    Dim Cl As Range

    Set Ws = Sheets("Margin Model 1")
    With Sheets("Summary")
        For Each Cl In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
            Ws.Range("A2").Value = Cl.Value
            .Range("C" & Cl.Row).Resize(, 2).Value = Ws.Range("B3:B4")
            .Range("E" & Cl.Row).Resize(, 2).Value = Ws.Range("B4:B5")
        Next Cl
    End With
    
    Ws.Select
    Range("A1").Select

End Sub

 

[m5edward]

Thank you so much for your response. It's hard to tell if that's what I need. I tried to run it but replacing the fictional cell locations with the real ones, but I suck at coding lol.

Any chance you could put in the real cell locations? It would be greatly appreciated. Sorry for the extra ask, I thought I could handle replacing the cells myself...but apparently I can't. My bad.

Summary Table
The store number being grabbed starts in A3 and ends at A69. The data retrieved from 'Margin Model 1' is placed into cells starting C3:F3 and ends c69:f69.

Margin Model Table
The Store # from Summary Table is being placed into cell C1. The data being sent over to 'Summary Table' is from J6:K6 and J10:K10

Thank you so much for even attempting the original ask. You are a kind soul.

 

[Fluff]

Ok, try this

Sub Copy_test()

    Dim Ws As Worksheet
    Dim Cl As Range

    Set Ws = Sheets("Margin Model 1")
    With Sheets("Summary")
        For Each Cl In .Range("A3:A69")
            Ws.Range("C1").Value = Cl.Value
            .Range("C" & Cl.Row).Resize(, 2).Value = Ws.Range("J6:K6")
            .Range("E" & Cl.Row).Resize(, 2).Value = Ws.Range("J10:K10")
        Next Cl
    End With
    
    Sheets("Model").Select
    Range("A1").Select

End Sub

 

[m5edward]

You are amazing! It is so close to working. I ran the macro and it cycled through all the stores on the list but it didn't bring the records from "Margin Model 1" (J6:K6 & J10:K10) into the "Summary" page (C3:F3).

 

[Fluff]

Try stepping through the code line by line & see if the data is copied through.
To do this, in the VBE put the cursor anywhere in the macro & press F8.

 

[m5edward]

It seems to be running through as there are no errors either when I run it or press F8. And I see the store number being changed...but nothing gets written to the other sheet.

 

[Fluff]

When stepping through the code, do the values in J6:K6 &J10:K10 update?

 

[m5edward]

Hey, I actually fixed it. I changed it to paste the numbers in one by one.

Thank you so much!!! This is going to save me sooooo much time moving forward as this is a weekly process!!!

 

[Fluff]

Glad you got it sorted & thanks for the feedback