Copy and Paste Loop

[temerson]

Hello -

I have two sheets, Sheet 1 and Sheet 2. I would like to copy and paste the values from each of those sheets onto a new sheet, Sheet 3.

• All rows in Sheet 2 need to be duplicated for each cell in Sheet 1.
• Sheet 1 just has one column, with multiple rows.
• Sheet 2 has multiple columns and rows.

For example, Product 17 in cell A2 (Sheet 1) would appear 30 times in Column A (Sheet 3) as Sheet 2 has 30 rows. Then loop until the end of the list in Sheet 1.

Hopefully I explained this clearly! Thanks you all!

 

[JLGWhiz]

Sub t()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, i As Long
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
cnt = sh2.UsedRange.Rows.Count
    With sh1
        r = 2
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            sh3.Cells(r, 1).Resize(cnt) = .Cells(i, 1).Value
            sh2.UsedRange.Copy sh3.Cells(r, 2)
            r = r + 30
        Next
    End With
End Sub

 

[temerson]

JLGWhiz,

I should have posted my vba code for reference!

Sub CopyPaste()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, i As Long, x As Integer, ws As Worksheet


Set ws = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = "Brand By Vendor "

Sheets("Brand By Vendor ").Range("A1") = "STORE"
Sheets("Brand By Vendor ").Range("B1") = "BRAND CODE"
Sheets("Brand By Vendor ").Range("C1") = "BRAND NAME"

Set sh3 = Sheets("Brand By Vendor ")
Set sh2 = Sheets("Sheet2")
Set sh1 = Sheets("Sheet1")

Sheets("Sheet1").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
sh3.Range("B2").PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
sh2.Range("A2").Copy
sh3.Range("A2").PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
sh3.Range("A2:A" & Cells(Rows.Count, 2).End(xlUp).Row).FillDown

'loop portion
Sheets("Sheet1").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
sh3.Cells(Rows.Count, 1).End(xlUp).Offset(1, 1).PasteSpecial xlPasteValues
sh2.Range("A2").Offset(1, 0).Copy
sh3.Cells(Rows.Count, 1).End(xlUp).PasteSpecial xlPasteValues
sh3.Range("A2:A" & Cells(Rows.Count, 2).End(xlUp).Row).FillDown

End Sub

I need this to loop

The bold is where I am running into a problem, the A2 in sh2.Range("A2").Offset(1, 0).Copy is static is needs to be dynamic where it will move down one cell to copy and paste; also it needs to stop if there is a blank cell.

In addition, the A2 in sh3.Range("A2:A" & Cells(Rows.Count, 2).End(xlUp).Row).FillDown needs to be changed where it autofill down to the last row in Column 2.

 

[JLGWhiz]

You lost me. The code does not give any better explanation of what data you want taken from where and put where.

 

[temerson]

In sh2, there is a list of Store Numbers and I want the code to copy and paste onto the the last row +1 (first blank cell) in sh3. Then autofill this down to the last row in Column B.

In sh2, how the code is currently written, I dont know where or how continuously move down the Store Numbers list to copy/paste to sh3.

 

[JLGWhiz]

In sh2, there is a list of Store Numbers and I want the code to copy and paste onto the the last row +1 (first blank cell) in sh3. Then autofill this down to the last row in Column B.

In sh2, how the code is currently written, I dont know where or how continuously move down the Store Numbers list to copy/paste to sh3.

This is not what you described in post #1. It appears that the sheet numbers have been reversed. I understand that you want to loop so that the each store number will appear on the row with their product but you have confused the issue so that I don't know which sheet contains what. Can you post a screen shot or use the xl2bb tool to post images of your sheets so we can refer to them properly?