Copy range to another sheet when match conditions

nhnn1986

Board Regular
Joined
Oct 12, 2017
Messages
78
Hi all
Hi have sheet(data) and sheet(source) like belove
Sheet(data):
ABC
1A123999888
2A124456789
3A125123456
4A126741852
5A127987987

<tbody>
</tbody>

And Sheet(source):
ABCDE
1......A121123456
2......A122456789
3......A123789789
4......A124147258
5......A129456987

<tbody>
</tbody>

Now I want macro to combine from sheet(source) to sheet(data):
if match value sheet(source).column(C) with sheet(data).column(A) => data will sort in by sheet(data).Column(A) and combine like belove

ABCDEF
1A12100123456
2A12200456789
3A123999888789789
4A124456789147258
5A12512345600
6A12674185200
7A12798798700
8A12900456789
9

<tbody>
</tbody>

Please help me to do this by macro. I need row is dynamic, this mean use last row in sheet(data).columnA and sheet(source).column(C)
thanks./.
 

Some videos you may like

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
16,732
Re: How can I copy range to another sheet when match conditions

This consolidates everything to the Data sheet. Assumes layouts for Data and Source sheets you have posted.
Code:
Sub nhnn1986()
Dim RD As Range, RS As Range, Rw As Range, n As Variant, i As Long
Set RD = Sheets("Data").Range("A1:E" & Sheets("Data").Cells(Sheets("Data").Rows.Count, "A").End(xlUp).Row)
Set RS = Sheets("source").Range("C1:E" & Sheets("Source").Cells(Sheets("Source").Rows.Count, "C").End(xlUp).Row)
Application.ScreenUpdating = False
For i = 1 To RS.Rows.Count
    n = Application.Match(RS.Rows(i).Cells(1), RD.Columns(1), 0)
    If IsError(n) Then
        RD.Rows(1).Insert shift:=xlDown
        With RD.Rows(1).Offset(-1, 0)
            .Value = RS.Rows(i).Value
            .Cells(1, 2).Resize(1, 2).Insert shift:=xlToRight
        End With
    Else
        RD.Rows(n).Cells(1, 4).Resize(1, 2).Value = RS.Rows(i).Cells(1, 2).Resize(1, 2).Value
    End If
Next i
With RD.CurrentRegion
    On Error Resume Next
    .Resize(, 5).SpecialCells(xlCellTypeBlanks).Value = 0
    .SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
    On Error GoTo 0
    .Sort key1:=[A1], order1:=xlAscending, Header:=xlNo
End With
Application.ScreenUpdating = True
End Sub
 

nhnn1986

Board Regular
Joined
Oct 12, 2017
Messages
78
Re: How can I copy range to another sheet when match conditions

Thanks for your code @JoeMo, code work well.

May I have another question? I want code to do more that with data after run your code:
Each cel in sheet(data).Column(F) = Column(B) - Column(D), this mean Fi = Bi - Di then Gi = Fi/Di
Each cel in sheet(data).Column(H) = Column(C) - Column(E), this mean Hi = Ci - Ei then Ii = Hi/Ei



 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
16,732
Re: How can I copy range to another sheet when match conditions

Thanks for your code @JoeMo, code work well.

May I have another question? I want code to do more that with data after run your code:
Each cel in sheet(data).Column(F) = Column(B) - Column(D), this mean Fi = Bi - Di then Gi = Fi/Di
Each cel in sheet(data).Column(H) = Column(C) - Column(E), this mean Hi = Ci - Ei then Ii = Hi/Ei



Thanks for the reply. Here's a revision that covers your new question. Formulas can be converted to values if you wish. Note that you division columns D & E may cause some #DIV/0! errors. If that's not what you want, wrap the formulas in IFERROR and choose what you want it to return.
Code:
Sub nhnn1986()
Dim RD As Range, RS As Range, n As Variant, i As Long
Set RD = Sheets("Data").Range("A1:E" & Sheets("Data").Cells(Sheets("Data").Rows.Count, "A").End(xlUp).Row)
Set RS = Sheets("source").Range("C1:E" & Sheets("Source").Cells(Sheets("Source").Rows.Count, "C").End(xlUp).Row)
Application.ScreenUpdating = False
For i = 1 To RS.Rows.Count
    n = Application.Match(RS.Rows(i).Cells(1), RD.Columns(1), 0)
    If IsError(n) Then
        RD.Rows(1).Insert shift:=xlDown
        With RD.Rows(1).Offset(-1, 0)
            .Value = RS.Rows(i).Value
            .Cells(1, 2).Resize(1, 2).Insert shift:=xlToRight
        End With
    Else
        RD.Rows(n).Cells(1, 4).Resize(1, 2).Value = RS.Rows(i).Cells(1, 2).Resize(1, 2).Value
    End If
Next i
With RD.CurrentRegion
    On Error Resume Next
    .Resize(, 5).SpecialCells(xlCellTypeBlanks).Value = 0
    .SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
    On Error GoTo 0
    .Sort key1:=[A1], order1:=xlAscending, Header:=xlNo
End With
Set RD = Range("A1").CurrentRegion
With RD
    .Columns(5).Offset(0, 1).Formula = "=$B1-$D1"
    .Columns(5).Offset(0, 2).Formula = "=$F1/$D1"
    .Columns(5).Offset(0, 3).Formula = "=$C1-$E1"
    .Columns(5).Offset(0, 4).Formula = "=$H1/$E1"
End With
Application.ScreenUpdating = True
End Sub
 
Last edited:

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
16,732
Re: How can I copy range to another sheet when match conditions

Ignore the code in the prior post which may error if you don't run it with the Data sheet active.
Use this instead:
Code:
Sub nhnn1986()
Dim RD As Range, RS As Range, n As Variant, i As Long
Set RD = Sheets("Data").Range("A1:E" & Sheets("Data").Cells(Sheets("Data").Rows.Count, "A").End(xlUp).Row)
Set RS = Sheets("source").Range("C1:E" & Sheets("Source").Cells(Sheets("Source").Rows.Count, "C").End(xlUp).Row)
Application.ScreenUpdating = False
For i = 1 To RS.Rows.Count
    n = Application.Match(RS.Rows(i).Cells(1), RD.Columns(1), 0)
    If IsError(n) Then
        RD.Rows(1).Insert shift:=xlDown
        With RD.Rows(1).Offset(-1, 0)
            .Value = RS.Rows(i).Value
            .Cells(1, 2).Resize(1, 2).Insert shift:=xlToRight
        End With
    Else
        RD.Rows(n).Cells(1, 4).Resize(1, 2).Value = RS.Rows(i).Cells(1, 2).Resize(1, 2).Value
    End If
Next i
With RD.CurrentRegion
    On Error Resume Next
    .Resize(, 5).SpecialCells(xlCellTypeBlanks).Value = 0
    .SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
    On Error GoTo 0
    .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
End With
Set RD = Sheets("Data").Range("A1").CurrentRegion
With RD
    .Columns(5).Offset(0, 1).Formula = "=$B1-$D1"
    .Columns(5).Offset(0, 2).Formula = "=$F1/$D1"
    .Columns(5).Offset(0, 3).Formula = "=$C1-$E1"
    .Columns(5).Offset(0, 4).Formula = "=$H1/$E1"
End With
Application.ScreenUpdating = True
End Sub
 

nhnn1986

Board Regular
Joined
Oct 12, 2017
Messages
78
Re: How can I copy range to another sheet when match conditions

Thanks very much, JoeMo

Code work well but there's small problem that I want only value, not formula in column F,G,H,I.

I now we will patch as value but I can't code them. Of you have free time please help me one again.

Thanks./.
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
16,732
Re: How can I copy range to another sheet when match conditions

Thanks very much, JoeMo

Code work well but there's small problem that I want only value, not formula in column F,G,H,I.

I now we will patch as value but I can't code them. Of you have free time please help me one again.

Thanks./.
You are welcome - thanks for the reply.
Here's a modification that will provide values only in cols F:I.
Code:
Sub nhnn1986()
Dim RD As Range, RS As Range, n As Variant, i As Long
Set RD = Sheets("Data").Range("A1:E" & Sheets("Data").Cells(Sheets("Data").Rows.Count, "A").End(xlUp).Row)
Set RS = Sheets("source").Range("C1:E" & Sheets("Source").Cells(Sheets("Source").Rows.Count, "C").End(xlUp).Row)
Application.ScreenUpdating = False
For i = 1 To RS.Rows.Count
    n = Application.Match(RS.Rows(i).Cells(1), RD.Columns(1), 0)
    If IsError(n) Then
        RD.Rows(1).Insert shift:=xlDown
        With RD.Rows(1).Offset(-1, 0)
            .Value = RS.Rows(i).Value
            .Cells(1, 2).Resize(1, 2).Insert shift:=xlToRight
        End With
    Else
        RD.Rows(n).Cells(1, 4).Resize(1, 2).Value = RS.Rows(i).Cells(1, 2).Resize(1, 2).Value
    End If
Next i
With RD.CurrentRegion
    On Error Resume Next
    .Resize(, 5).SpecialCells(xlCellTypeBlanks).Value = 0
    .SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
    On Error GoTo 0
    .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
End With
Set RD = Sheets("Data").Range("A1").CurrentRegion
With RD
    .Columns(5).Offset(0, 1).Formula = "=$B1-$D1"
    .Columns(5).Offset(0, 2).Formula = "=$F1/$D1"
    .Columns(5).Offset(0, 3).Formula = "=$C1-$E1"
    .Columns(5).Offset(0, 4).Formula = "=$H1/$E1"
    .Calculate
    .Columns(5).Offset(0, 1).Resize(, 4).Value = .Columns(5).Offset(0, 1).Resize(, 4).Value
End With
Application.ScreenUpdating = True
End Sub
 

nhnn1986

Board Regular
Joined
Oct 12, 2017
Messages
78
Re: How can I copy range to another sheet when match conditions

Thanks JoeMo, code word perfect with me
 

Watch MrExcel Video

Forum statistics

Threads
1,095,364
Messages
5,444,027
Members
405,261
Latest member
Khauff

This Week's Hot Topics

Top