i am needing a way to place information in a template and copy this template for as many items as i have. As seen in the attached spreadsheet on sheet1 the template is 6 columns and 5 rows. The colors correspond to the information needed on sheet 2. this template includes data from row 3 on sheet 2. I need a macro that will copy this template and return the next row of data from sheet2. this has me stumped. Also the data changes on sheet, so it may have many rows or just a couple. Thanks for the help.
Copy Values Between 2 Worksheet With Offset
-
-
-
Re: Copy Data Loop
zotee98 - up above your post there is a section called possible answers. See if any of those solutions help you. If not, post back and someone will assist you.
-
Re: Copy Data Loop
i cant find one that applies to this situation. my problem is when i paste excel moves the cells down the number of rows i pasted. instead of a4 it becomes a9.
-
Re: Copy Data Loop
zotee98 - Give this a shot and let me know how it goes.
Code
Display MoreSub CopyStuff() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Integer Dim sht1Rows As Long Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") For x = 3 To ws2.Range("A" & Rows.Count).End(xlUp).Row sht1Rows = ws1.Range("C" & Rows.Count).End(xlUp).Row ws1.Range("A" & sht1Rows).Offset(-2, 0) = ws2.Range("A" & x).Value ws1.Range("B" & sht1Rows).Offset(-2, 0) = ws2.Range("B" & x).Value ws1.Range("B" & sht1Rows).Offset(-1, 0) = ws2.Range("C" & x).Value ws1.Range("D" & sht1Rows).Offset(-3, 0) = ws2.Range("D" & x).Value If x = ws2.Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub ws1.Range(Cells(sht1Rows - 5, 1), Cells(sht1Rows, 6)).Copy ws1.Range("A" & sht1Rows).Offset(1, 0) Next x End Sub
[hr]*[/hr] Auto Merged Post;[dl]*[/dl]Use this revised code. It clears the original tables before making more.
Code
Display MoreSub CopyStuff() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Integer Dim sht1Rows As Long Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") sht1Rows = ws1.Range("C" & Rows.Count).End(xlUp).Row If sht1Rows > 7 Then ws1.Range("A8:F" & sht1Rows).Clear End If For x = 3 To ws2.Range("A" & Rows.Count).End(xlUp).Row sht1Rows = ws1.Range("C" & Rows.Count).End(xlUp).Row ws1.Range("A" & sht1Rows).Offset(-2, 0) = ws2.Range("A" & x).Value ws1.Range("B" & sht1Rows).Offset(-2, 0) = ws2.Range("B" & x).Value ws1.Range("B" & sht1Rows).Offset(-1, 0) = ws2.Range("C" & x).Value ws1.Range("D" & sht1Rows).Offset(-3, 0) = ws2.Range("D" & x).Value If x = ws2.Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub ws1.Range(Cells(sht1Rows - 5, 1), Cells(sht1Rows, 6)).Copy ws1.Range("A" & sht1Rows).Offset(1, 0) Next x End Sub
-
Re: Copy Data Loop
wow that worked great - thanks - this forum is sweet![hr]*[/hr] Auto Merged Post;[dl]*[/dl]
Code
Display MoreSub CopyQTY() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Integer Dim sht1Rows As Long Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") For x = 3 To ws2.Range("A" & Rows.Count).End(xlUp).Row sht1Rows = ws1.Range("C" & Rows.Count).End(xlUp).Row ws1.Range("A" & sht1Rows).Offset(-4, 0) = ws2.Range("A" & x).Value ws1.Range("B" & sht1Rows).Offset(-4, 0) = ws2.Range("C" & x).Value ws1.Range("B" & sht1Rows).Offset(-3, 0) = ws2.Range("D" & x).Value ws1.Range("D" & sht1Rows).Offset(-3, 0) = ws2.Range("B" & x).Value If x = ws2.Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub ws1.Range(Cells(sht1Rows - 7, 1), Cells(sht1Rows, 8)).COPY ws1.Range("A" & sht1Rows).Offset(1, 0) Next x End Sub
why can i not do a -4 for "ws1.Range("D" & sht1Rows).Offset(-3, 0)" i am totally stump -
-
Re: Copy Data Loop
zotee98 - I take it your real tables are different from those in your example? The offset is based on column C, specifically I used the word BID to identify that last row of a table. With that, and since each table was 5 rows tall is the reason for my particular offsets. If you want to see what the address is of one of your offsets, right after the for statement use something like this. In this way, you can see the address of each offset and verify if that is where you want your value placed.
Code
Display MoreSub CopyQTY() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Integer Dim sht1Rows As Long Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") For x = 3 To ws2.Range("A" & Rows.Count).End(xlUp).Row msgbox ws1.Range("A" & sht1Rows).Offset(-4, 0).address'use this to see if the offset is where you think it is sht1Rows = ws1.Range("C" & Rows.Count).End(xlUp).Row ws1.Range("A" & sht1Rows).Offset(-4, 0) = ws2.Range("A" & x).Value ws1.Range("B" & sht1Rows).Offset(-4, 0) = ws2.Range("C" & x).Value ws1.Range("B" & sht1Rows).Offset(-3, 0) = ws2.Range("D" & x).Value ws1.Range("D" & sht1Rows).Offset(-3, 0) = ws2.Range("B" & x).Value If x = ws2.Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub ws1.Range(Cells(sht1Rows - 7, 1), Cells(sht1Rows, 8)).COPY ws1.Range("A" & sht1Rows).Offset(1, 0) Next x End Sub
-
Re: Copy Data Loop
Quotei cant find one that applies to this situation.
That's because you used the Thread Title to state what you THINK your answer is and not what you are trying to do.
[fa]*[/fa]
Participate now!
Don’t have an account yet? Register yourself now and be a part of our community!