Conditionally copy cells into non-consecutive columns

[ChrisG29]

I've been using a VBA macro to copy cells from one sheet to another, but I now to make a slight modification which I'm struggling with. My sheets look as follows:

Sheet 1

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Code
[/TD]
[TD]Description
[/TD]
[TD]Unit
[/TD]
[TD]Price
[/TD]
[/TR]
[TR]
[TD]AB
[/TD]
[TD]Item 1
[/TD]
[TD]KG
[/TD]
[TD]10
[/TD]
[/TR]
[TR]
[TD]CD
[/TD]
[TD]Item 2
[/TD]
[TD]Litre
[/TD]
[TD]20
[/TD]
[/TR]
[TR]
[TD]EF
[/TD]
[TD]Item 3
[/TD]
[TD]KG
[/TD]
[TD]30
[/TD]
[/TR]
</tbody>[/TABLE]


Sheet 2

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Unit
[/TD]
[TD]Code
[/TD]
[TD]Description
[/TD]
[TD]Price
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]CD
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]EF
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]AB
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


For each of the codes in Sheet 2 I need to look up the code in Sheet and populate the cells accordingly. The problem I have is that the columns in Sheet don't match the order of the columns in Sheet 1. The macro I've been using below populates the columns after Code in order. Please can someone help me modify this:

Sub ()
Dim myCell As Range, FndCell As Range
For Each myCell In Sheets("Sheet1").Range("A2:A" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row)
Set FndCell = Sheets("Sheet2").Range("A1:A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row).Find(myCell.Value, , xlValues, , xlByRows, xlNext)
If Not FndCell Is Nothing Then
myCell.Offset(, 1).Resize(1, 3).Copy FndCell.Offset(, 1)
End If
Next
End Sub

 

[hiker95]

ChrisG29,

Welcome to the MrExcel forum.

If I understand you correctly, then, here is a macro solution for you to consider.

Sample worksheets:

Excel 2007
	A	B	C	D
1	Code	Description	Unit	Price
2	AB	Item 1	KG	10
3	CD	Item 2	Litre	20
4	EF	Item 3	KG	30
5
Sheet1

Excel 2007
	A	B	C	D
1	Unit	Code	Description	Price
2		CD
3		EF
4		AB
5
Sheet2

And, after the macro:

Excel 2007
	A	B	C	D
1	Unit	Code	Description	Price
2	Litre	CD	Item 2	20
3	KG	EF	Item 3	30
4	KG	AB	Item 1	10
5
Sheet2

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub ChrisG29()
' hiker95, 06/29/2017, ME1011945
Dim w1 As Worksheet, w2 As Worksheet
Dim b As Range, a As Range
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
With w2
  For Each b In .Range("B2", .Range("B" & Rows.Count).End(xlUp))
    Set a = w1.Columns(1).Find(b.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      b.Offset(, -1).Value = w1.Cells(a.Row, 3).Value
      b.Offset(, 1).Value = w1.Cells(a.Row, 2).Value
      b.Offset(, 2).Value = w1.Cells(a.Row, 4).Value
    End If
  Next b
  .Columns.AutoFit
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ChrisG29 macro.

 

[ChrisG29]

That worked perfectly, thank you so much

 

[hiker95]

That worked perfectly, thank you so much

ChrisG29,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.