Step through range x, copy and paste columns in range y based on values in range x

[mac8832]

Thank you in advance for your consideration and help. I am new to the message board and hope I find a VBA solution to the following:

I want to step through values within range x in worksheet1 to the extent the range contains numerical values (end loop after last row of data is passed). When within the loop, I want to lookup range y in worksheet2 based on the cell value in range x, then copy and paste range y to worksheet3. When pasting range y to worksheet3, I do not want to overwrite existing data, but paste to the right of the last column with data. For each value in range x in worksheet1, there are three columns in worksheet2 to copy and paste to worksheet3 (i.e, 3 in range x corresponds to 3x 3's in range y).

range x in worksheet1:




range y in worksheet2:

copy/paste to worksheet3:

The left border on column D indicates where the first column of data is pasted. As I had mentioned above, 3 columns in range y will be pasted per 1 value in range x. Once pasted, the next 3 columns in range y corresponding to the next value in range x will be pasted to the next three columns to the right.

Thank you again.

 

[DanteAmor]

Hi and welcome to MrExcel

Assuming the data on sheet1 starts in cell A2.
Assuming the data on sheet2 starts in cell A1.

Try this

Sub copycolumns()
  Dim i As Long, lr As Long
  Dim c As Range, f As Range, r As Range
  
  With Sheets("Sheet2")
    lr = .Range("A" & Rows.Count).End(3).Row
    For Each c In Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("A" & Rows.Count).End(3))
      Set f = .Rows(1).Find(c.Value, , xlValues, xlWhole)
      If Not f Is Nothing Then
        If r Is Nothing Then Set r = f.Resize(lr, 3) Else Set r = Union(r, f.Resize(lr, 3))
      End If
    Next
  End With
  r.Copy Sheets("Sheet3").Range("D2")
End Sub

________________________________________
Note:
In the following threads that you create, you can Use Xl2BB tool minisheets to show examples.
________________________________________

 

[mac8832]

DanteAmor,

Thank you. It worked very well .

Taking this a step further, how would I expand on the above code to include the following:

I am inclined to think that this would fit in after End With. Once the 'with loop' ends and range r is copied to worksheet3, how would I paste range r into a user-defined worksheet?

All other things the same,

The cell in worksheet1 containing "Sheet 4" indicates that range r will be pasted to worksheet4. However, the user may change this cell to indicate another worksheet to paste range r:

Here, range r is pasted to worksheet3.

I am attempting to place an If/Else loop and lookup function after End With, but am so far unsuccessful in pasting range r to any worksheet (worksheets 4 - 7) beyond.

Thank you, again, for taking a look at this and coming to an elegant solution to my previous post.

 

[DanteAmor]

Change this line:

  r.Copy Sheets("Sheet3").Range("D2")

For this line:

  r.Copy Sheets(Sheets("Sheet1").Range("E2").Value).Range("D2")

In cell E2 of sheet1 you must put the name of the destination sheet.

 

[mac8832]

I was able to make it work with a big block of If/ElseIf statements. I deleted that block, inserted what you've shown above, and it works perfectly. Thank you.

Now, what code would I need to ensure that once I have pasted range r to the destination sheet and save and close the workbook, the next time I open the workbook and paste range r to the same destination sheet, I do not overwrite range r data that is already in that destination sheet (or, any destination sheet already containing range r data). I notice that when I change the values of range x in worksheet1, I overwrite range r data that already exists in the destination sheet.

 

[DanteAmor]

Change to this:

r.Copy Sheets(Sheets("Sheet1").Range("E2").Value).Range("D" & Rows.Count).End(3)(2)

 

[mac8832]

DanteAmor, this worked well in appending data vertically without overwriting existing data. Is there a way I can append columns to the right of the existing data?

I appreciate all your help here.

 

[DanteAmor]

@mac8832 You marked one of your answers as a solution, you must mark as a solution one of the answers that really solved your request.

 

[mac8832]

Understood, thanks for the guidance. I unmarked the request as I just sent an additional request (#7).

 

[DanteAmor]

Try this

Sub copycolumns()
  Dim i As Long, lr As Long, lc As Long
  Dim c As Range, f As Range, r As Range
  Dim sName As String
  
  With Sheets("Sheet2")
    lr = .Range("A" & Rows.Count).End(3).Row
    For Each c In Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("A" & Rows.Count).End(3))
      Set f = .Rows(1).Find(c.Value, , xlValues, xlWhole)
      If Not f Is Nothing Then
        If r Is Nothing Then Set r = f.Resize(lr, 3) Else Set r = Union(r, f.Resize(lr, 3))
      End If
    Next
  End With
  sName = Sheets("Sheet1").Range("E2").Value
  lc = Sheets(sName).Cells(2, Columns.Count).End(1).Column + 1
  lc = WorksheetFunction.Max(4, lc)
  r.Copy Sheets(sName).Cells(2, lc)
End Sub