Need a macro

[Lavan]

Hello Experts,

I need a macro to move the entire row to next sheet if the value in column A matches.. For example my data is like below . If any cell value in column A matches to "a", I want that entire row to be moved to sheet2. So all the rows with cell value "a" in column A, should be moved to sheet2 after I run the macro.

Thanks in advance,
Lavan


a 1 1
b 2 3
a 4 4
b 2 1
c 3 3
d 14 4
a 3 4
a 1 3
f 1 1
f 2 2
a 5 5

 

[facethegod]

if your data is in Columns A,B,C try this macro

Public Sub Copyvalue()
Dim Lrow, i, j, x As Integer
x = 1
Lrow = Range("A65535").End(xlUp).Row
For i = 1 To Lrow
    If Cells(i, 1) = "a" Then
            With Range("B" & i).Resize(, 2)
                While Worksheets(2).Cells(x, 1) <> ""
                    x = x + 1
                Wend
                .Copy Destination:=Worksheets(2).Range("A" & x)
            End With
    End If
Next
End Sub

 

[Peter_SSs]

Lavan

Welcome to the MrExcel board!

If you have a lot of rows of data, the following code that avoids the looping may be quicker. In any case, it is another option to consider. The code assumes that there are no headings on the columns in Sheet1. If that assumption is incorrect, then a slight modification could be made to the code and that modification would depend on wheteher you wanted the headings copied across to Sheet2 as well.

My other assumption is that Sheet1 will be the active sheet when the code is run. Again, modifications can be made if this is not correct.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> CopyRows()
    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    
    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
    Rows(1).EntireRow.Insert
    lr = Range("A" & Rows.Count).End(xlUp).Row
    <SPAN style="color:#00007F">With</SPAN> Range("A1:A" & lr)
        .AutoFilter Field:=1, Criteria1:="a"
        .Resize(.Rows.Count - 1, 3).Offset(1).Copy _
            Destination:=Sheets("Sheet2").Range("A1")
        .AutoFilter
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
    Rows(1).EntireRow.Delete
    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[Lavan]

Peter, Thanks a milllion. Its very very fast and exact match to my requirement. Thanks again.

Lavan

 

[Lavan]

Peter,

I have modified your code according to my requirement to move the data to different sheets as below. The problem is my data is not same always, so code is returning error if the data I am trying to move to a sheet is not available. Below is the code I am using, for example if the value "FA-3A Port 0" is not available, it returning the error. Please let me know how to proceed to next even if some of the search valumes not existing in data.

Thanks in Advance,


Sub CopyRows_new()
Dim lr As Long

'Application.ScreenUpdating = False

Sheets.Add.Name = "FA-3A Port 0"
Sheets.Add.Name = "FA-3A Port 1"
Sheets.Add.Name = "FA-3B Port 0"
Sheets.Add.Name = "FA-3B Port 1"
Sheets.Add.Name = "FA-3C Port 0"
Sheets.Add.Name = "FA-3C Port 1"


Rows(1).EntireRow.Insert
lr = Range("A" & Rows.Count).End(xlUp).Row
With Range("A1:A" & lr)
.AutoFilter Field:=1, Criteria1:="FA-3A Port 0"
.Resize(.Rows.Count - 1, 8).Offset(1).Copy _
Destination:=Sheets("FA-3A Port 0").Range("A1")
.AutoFilter
.AutoFilter Field:=1, Criteria1:="FA-3A Port 1"
.Resize(.Rows.Count - 1, 8).Offset(1).Copy _
Destination:=Sheets("FA-3A Port 1").Range("A1")
.AutoFilter
.AutoFilter Field:=1, Criteria1:="FA-3B Port 0"
.Resize(.Rows.Count - 1, 8).Offset(1).Copy _
Destination:=Sheets("FA-3B Port 0").Range("A1")
.AutoFilter
.AutoFilter Field:=1, Criteria1:="FA-3B Port 1"
.Resize(.Rows.Count - 1, 8).Offset(1).Copy _
Destination:=Sheets("FA-3B Port 1").Range("A1")
.AutoFilter
.AutoFilter Field:=1, Criteria1:="FA-3C Port 0"
.Resize(.Rows.Count - 1, 8).Offset(1).Copy _
Destination:=Sheets("FA-3C Port 0").Range("A1")
.AutoFilter
.AutoFilter Field:=1, Criteria1:="FA-3C Port 1"
.Resize(.Rows.Count - 1, 8).Offset(1).Copy _
Destination:=Sheets("FA-3C Port 1").Range("A1")
.AutoFilter


End With
Rows(1).EntireRow.Delete
Sheets("masking").Select
Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Lavan

I haven't actually run a test but I think this should solve your problem. change the filter and copy part as follows:

With Range("A1:A" & lr)
On Error Resume Next
.
.
rest of the filter/copy code here
.
.
On Error GoTo 0
End With

 

[Lavan]

Peter,

I have used below code, now error returning is stopped. But its returning the data of the 1st sheet to all the sheets where data is not available. With respect to below code, I dont have data available in my spread sheet for all FA-10XPort1 sheets, I have data available only for FA-10XPort0, but code is retuning FA-10APort0 values to all the sheets of FA-10Xport1. As the data is not availble for any FA-10XPort1, All the sheets of FA-10Xport1 should be blank. Please help.

PS: FA-10XPort1 refers to FA-10APort1, FA-10BPort1 etc

thanks in advance,
Lavan


Sub CopyRows_new()
Dim lr As Long

Application.ScreenUpdating = False


Sheets.Add.Name = "FA-10APort0"
Sheets.Add.Name = "FA-10APort1"
Sheets.Add.Name = "FA-10BPort0"
Sheets.Add.Name = "FA-10BPort1"
Sheets.Add.Name = "FA-10CPort0"
Sheets.Add.Name = "FA-10CPort1"
Sheets.Add.Name = "FA-10DPort0"
Sheets.Add.Name = "FA-10DPort1"


Rows(1).EntireRow.Insert
lr = Range("A" & Rows.Count).End(xlUp).Row
With Range("A1:A" & lr)
On Error Resume Next


.AutoFilter Field:=1, Criteria1:="FA-10APort0"
.Resize(.Rows.Count - 1, 10).Offset(1).Copy _
Destination:=Sheets("FA-10APort0").Range("A1")
.AutoFilter

.AutoFilter Field:=1, Criteria1:="FA-10APort1"
.Resize(.Rows.Count - 1, 10).Offset(1).Copy _
Destination:=Sheets("FA-10APort1").Range("A1")
.AutoFilter

.AutoFilter Field:=1, Criteria1:="FA-10BPort0"
.Resize(.Rows.Count - 1, 10).Offset(1).Copy _
Destination:=Sheets("FA-10BPort0").Range("A1")
.AutoFilter

.AutoFilter Field:=1, Criteria1:="FA-10BPort1"
.Resize(.Rows.Count - 1, 10).Offset(1).Copy _
Destination:=Sheets("FA-10BPort1").Range("A1")
.AutoFilter

.AutoFilter Field:=1, Criteria1:="FA-10CPort0"
.Resize(.Rows.Count - 1, 10).Offset(1).Copy _
Destination:=Sheets("FA-10CPort0").Range("A1")
.AutoFilter

.AutoFilter Field:=1, Criteria1:="FA-10CPort1"
.Resize(.Rows.Count - 1, 10).Offset(1).Copy _
Destination:=Sheets("FA-10CPort1").Range("A1")
.AutoFilter

.AutoFilter Field:=1, Criteria1:="FA-10DPort0"
.Resize(.Rows.Count - 1, 10).Offset(1).Copy _
Destination:=Sheets("FA-10DPort0").Range("A1")
.AutoFilter

.AutoFilter Field:=1, Criteria1:="FA-10DPort1"
.Resize(.Rows.Count - 1, 10).Offset(1).Copy _
Destination:=Sheets("FA-10DPort1").Range("A1")
.AutoFilter

On Error GoTo 0
End With
Rows(1).EntireRow.Delete
Sheets("masking").Select
Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

I am not sur I understand all that but try this:
Just below all the
Sheets.Add.Name...
rows, put
Sheets("masking").Activate
only replace "masking" if it is not the sheet with all the info on to start with.