Copy row base on column value to another sheet with match header

[maiwarits]

Hi!

I need the code to match input value then copy data only the header show in sheet2.
But my code copy entire row and place them in the same row on sheet2 after executing.


This my data with many column and row the source data is in the column G.

Copy from sheet1 to sheet2 by match the header after click find. Like this picture.

Option Explicit

Sub Test()

Dim Cell As Range

With Sheets(1)
    ''''' loop column G untill last cell with value
    For Each Cell In .Range("G1:G" & .Cells(.Rows.Count, "G").End(xlUp).Row)
        If Cell.Value = "NB016" Then
             ' Copy>>Paste
            .Rows(Cell.Row).Copy Destination:=Sheets(2).Rows(Cell.Row)
        End If
    Next Cell
End With

End Sub

 

[vcoolio]

Hello maiwarits,

Using the Autofilter rather than a loop construct is generally a more efficient and quicker method:-
Assuming that the relevant headings are already in place in Sheet2, assign the following code to your button to see if it suits:-

Option Explicit

Sub Test2()

    Dim crit As String: crit = Sheet2.Range("B1").Value
    
    Application.ScreenUpdating = False
    
            With Sheet1.[A1].CurrentRegion
                    .AutoFilter 7, crit
                    Union(.Columns("A:B"), .Columns("E"), .Columns("H:I")).Offset(1).Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
                    .AutoFilter
            End With
     
     Application.ScreenUpdating = True
 
End Sub

This way, you will only need to change the criteria in Sheet 2 (B1) to filter/copy/paste the required criteria.

I hope that this helps.

Cheerio,
vcoolio.

 

[maiwarits]

Hello maiwarits,

Using the Autofilter rather than a loop construct is generally a more efficient and quicker method:-
Assuming that the relevant headings are already in place in Sheet2, assign the following code to your button to see if it suits:-

Option Explicit

Sub Test2()

    Dim crit As String: crit = Sheet2.Range("B1").Value
   
    Application.ScreenUpdating = False
   
            With Sheet1.[A1].CurrentRegion
                    .AutoFilter 7, crit
                    Union(.Columns("A:B"), .Columns("E"), .Columns("H:I")).Offset(1).Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
                    .AutoFilter
            End With
    
     Application.ScreenUpdating = True
 
End Sub

This way, you will only need to change the criteria in Sheet 2 (B1) to filter/copy/paste the required criteria.

I hope that this helps.

Cheerio,
vcoolio.

Hi Vcoolio,

Thanks for your help it work as my expect!

Next I try to add more criteria could you check is it correct, please?

They should copy when specify word in cell B1 on sheet2 match with column G in sheet1 and column F in sheet1 should have blank cell.

So, I have modified the code from you to this code.

Option Explicit

Sub Test2()

    Dim crit1 As String: crit1 = Sheet2.Range("B1").Value
    Dim crit2 As String: crit2 = Sheet1.column("F").Value("")

    Application.ScreenUpdating = False
   
            With Sheet1.[A1].CurrentRegion
                    .AutoFilter 7, crit1
                    .AutoFilter 6, crit2
                    Union(.Columns("A:B"), .Columns("E"), .Columns("H:I")).Offset(1).Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
                    .AutoFilter
            End With
    
     Application.ScreenUpdating = True
 
End Sub

 

[vcoolio]

Hello Maiwarits,

Are you saying that data should only be copy/pasted if the cell in Column F, adjacent to crit1 in Column G, is blank?

Cheerio,
vcoolio.

 

[maiwarits]

Hello Maiwarits,

Are you saying that data should only be copy/pasted if the cell in Column F, adjacent to crit1 in Column G, is blank?

Cheerio,
vcoolio.

Correct!

I try to add one more criteria like you are meaning but it's not working.

 

[vcoolio]

Ok Maiwarits,

Try it as follows:-

Option Explicit

Sub Test2()

    Dim crit1 As String: crit1 = Sheet2.Range("B1").Value

    Application.ScreenUpdating = False
   
            With Sheet1.[A1].CurrentRegion
                    .AutoFilter 6, ""
                    .AutoFilter 7, crit1
                    Union(.Columns("A:B"), .Columns("E"), .Columns("H:I")).Offset(1).Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
                    .AutoFilter
            End With
    
     Application.ScreenUpdating = True
 
End Sub

I hope that this helps.

Cheerio,
vcoolio.

 

[maiwarits]

Ok Maiwarits,

Try it as follows:-

Option Explicit

Sub Test2()

    Dim crit1 As String: crit1 = Sheet2.Range("B1").Value

    Application.ScreenUpdating = False
  
            With Sheet1.[A1].CurrentRegion
                    .AutoFilter 6, ""
                    .AutoFilter 7, crit1
                    Union(.Columns("A:B"), .Columns("E"), .Columns("H:I")).Offset(1).Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
                    .AutoFilter
            End With
   
     Application.ScreenUpdating = True
 
End Sub

I hope that this helps.

Cheerio,
vcoolio.

Just a simple line but it has worked perfectly!

 

[vcoolio]

You're welcome Maiwarits. I'm glad that I was able to help. Thanks for the feed back.

Cheerio,
vcoolio.

 

[maiwarits]

You're welcome Maiwarits. I'm glad that I was able to help. Thanks for the feed back.

Cheerio,
vcoolio.

Vcoolio

Hi one more issue (sorry for a lot of issues).

If I want to skip 2 specify text (Canceled, Order) in column F. So i add this code in the line but it code work only the last line.

.AutoFilter 6, "<>Order"
.AutoFilter 6, "<>Canceled"

The code skip only "Canceled" word.

 

[maiwarits]

I have use this line it can work now.

.AutoFilter 6, "<>Order", Operator:=xlAnd, Criteria2:="<>Canceled"

Thanks!