VBA-Excel Match Rows from sheet1 to sheet2 Question

Question

The following code compares column 2 of sheet2 and if found on sheet1 column 2 it will copy the entire row onto sheet 2. Each row is copied under the found row. My question is how do I copy just the columns that I want from that Row found and place it in the column that I want on the matching row?

Before I run the code

Sheet1:
Col1   Col2   Col3    Col4    Col5    Col6    Col7    Col8
55555   123     a       6       r       7       h       f
55555   124     b       7       e       0       o       s
55555   333     c       8       f       3       l       j
55555   656     d       9       k       1       e       l
55555   219     e       10      i       m       l       p

Sheet2:
Col1    Col2   Col3    Col4    Col5    Col6    Col7    Col8
55555   123                     
55555   124                     
55555   333                     
55555   656                     
55555   219                     

Results After I run the code 

Sheet2:
Col1   Col2   Col3   Col4   Col5   Col6   Col7   Col8
Col1   Col2   Col3   Col4   Col5   Col6   Col7   Col8

55555   123                     
55555   123     a       6    r      7      h      f

55555   124                     
55555   124     b       7     e     0      o      s

55555   333                     
55555   333     c       8     f     3      l      j

55555   656                     
55555   656     d       9     k      1     e      l

55555   219                     
55555   219     e       10    i      3     l      p

Desired results Sheet2: Not the whole row is copied from Sheet1 just the desired columns are copied to the desired columns. Starting on row 2, so the headers on Sheet 2 are not effected.

Sheet2:
Col1   Col2   Col3   Col4   Col5   Col6   Col7   Col8
55555   123                          r      
55555   124                          e          
55555   333                          f      
55555   656                          k      
55555   219                          i

Below is the code block.

Function Twins(RowIndex As Integer) As Boolean
    Dim Key
    Dim Target
    Dim Success
    Success = False
    If Not IsEmpty(Cells(RowIndex, 1).Value) Then
        Key = Cells(RowIndex, 2).Value

     Sheets("Sheet1").Select

        Set Target = Columns(2).Find(Key, LookIn:=xlValues)

        If Not Target Is Nothing Then
            Rows(Target.Row).Select
            Selection.Copy
            Sheets("Sheet2").Select
            Rows(RowIndex + 1).Select
            Selection.Insert Shift:=xlRight
            Rows(RowIndex + 2).Select
            Application.CutCopyMode = False
            Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(RowIndex + 3, 1).Select
            Success = True
        End If

    End If
    Twins = Success
End Function

Sub Match()
    Dim RowIndex As Integer
    Sheets("Sheet2").Select
    RowIndex = Cells.Row
    While Twins(RowIndex)
        RowIndex = RowIndex + 3
    Wend
End Sub

Dominique Dominique · Accepted Answer · 2020-04-26T16:39:15

This can be done using a simple formula, as you can see here:

Sheet1 looks as follows:

Col1.1   Col1.2
     a     1000
     b     2000
     c     3000

Sheet2 looks as follows:

Col2.1   Col2.2
   aaa
     b
   ccc

In Col2.2, I've put following formula (starting in cell B2):

=If(A2=Sheet1!A2;Sheet1!B2;"")

Then I dragged it down to the other rows and I got following results:

Col2.1    Col2.2
   aaa   <BLANK>
     b      2000
   ccc   <BLANK>

If the values don't simply match (Sheet2!A1 can be anywhere in Sheet1!A:A), then a simple Vlookup() formula might do the trick.

VBA-Excel Match Rows from sheet1 to sheet2 Question

1 Answers