Copy range to another sheet when match conditions

N

nhnn1986

Board Regular
Joined
Oct 12, 2017
Messages
92
Hi all
Hi have sheet(data) and sheet(source) like belove
Sheet(data):
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]A123[/TD]
[TD]999[/TD]
[TD]888[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]A124[/TD]
[TD]456[/TD]
[TD]789[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]A125[/TD]
[TD]123[/TD]
[TD]456[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]A126[/TD]
[TD]741[/TD]
[TD]852[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]A127[/TD]
[TD]987[/TD]
[TD]987[/TD]
[/TR]
</tbody>[/TABLE]

And Sheet(source):
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]...[/TD]
[TD]...[/TD]
[TD]A121[/TD]
[TD]123[/TD]
[TD]456[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]...[/TD]
[TD]...[/TD]
[TD]A122[/TD]
[TD]456[/TD]
[TD]789[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]...[/TD]
[TD]...[/TD]
[TD]A123[/TD]
[TD]789[/TD]
[TD]789[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]...[/TD]
[TD]...[/TD]
[TD]A124[/TD]
[TD]147[/TD]
[TD]258[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]...[/TD]
[TD]...[/TD]
[TD]A129[/TD]
[TD]456[/TD]
[TD]987[/TD]
[/TR]
</tbody>[/TABLE]

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

[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]A121[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]123[/TD]
[TD]456[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]A122[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]456[/TD]
[TD]789[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]A123[/TD]
[TD]999[/TD]
[TD]888[/TD]
[TD]789[/TD]
[TD]789[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]A124[/TD]
[TD]456[/TD]
[TD]789[/TD]
[TD]147[/TD]
[TD]258[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]A125[/TD]
[TD]123[/TD]
[TD]456[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]A126[/TD]
[TD]741[/TD]
[TD]852[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]A127[/TD]
[TD]987[/TD]
[TD]987[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]A129[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]456[/TD]
[TD]789[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

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

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
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

nhnn1986 said:
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
Click to expand...
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

nhnn1986 said:
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./.
Click to expand...
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
You must log in or register to reply here.

Similar threads

J
  • Question Question
Copy range to new sheet
Replies
2
Views
386
JAVEDR
J
M
  • Solved
copy lastrow for 12000 rows based on first row for each range
Replies
7
Views
533
Alex Blakenburg
A
M
  • Solved
match based on three comboboxes for multiple separated range from userform
2
Replies
14
Views
655
Maklil
M
R
  • Solved
Return Value from 2 Criteria ( Date and Symbol) from another sheet to Table of Horizontal(date) and Vertical(Symbol) format!
Replies
3
Views
456
kevin9999
K
M
  • Question Question
separate multiple separated ranges into multiple sheets
Replies
0
Views
445
Maklil
M

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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