Copy range to another sheet when match conditions

nhnn1986

Board Regular
Joined
Oct 12, 2017
Messages
92
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./.
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
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
 
Upvote 0
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



 
Upvote 0
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:
Upvote 0
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
 
Upvote 0
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./.
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,202
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top