Cut & paste

[Ks1102]

Hi, experts

Can u help me macros to CUT and Paste which base on the cells last character =“X” than cut to sheet2 from row 2 to down ..


Sample:
Sheet1 column A which string is the products name wanted to identify base on the last character if =”X” then cut the rows out to sheet2 from A2 to down.

don’t know is it possible to work, but wanna help.

Thanks

 

[Misca]

Here's one way to do it:

Sub FindCutAndPaste()
    
Dim c As Range
Dim Rng As Range
Dim Found As Range
Dim Val2BFound As String
    
    
Val2BFound = "X"
    
With Sheet1

    Set Rng = Intersect(.Range("A:A"), .UsedRange) 'Where to look for
    Set Found = Find_Range(Val2BFound, Rng) 'Looking for matching cells

    If Not Found Is Nothing Then
    
    'Matches found:
    'Makes sure the found value is the last value in cell:
        For Each c In Found
            With c
                If Right(.Value, 1) = Val2BFound Then
                'Cut & paste
                    With Sheet2
                        c.Cut Destination:=.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                'if you want other cells to be cut & pasted as well, tweak the "c.cut" bit;
                'c.EntireRow.cut cuts the whole row etc.
                    End With
                End If
            End With
        Next c
    End If

End With

End Sub

Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As Variant, _
    Optional LookAt As Variant, _
    Optional MatchCase As Boolean) As Range
     
    Dim c As Range
    If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
    If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
    If IsMissing(MatchCase) Then MatchCase = False

    With Search_Range
        Set c = .Find( _
        What:=Find_Item, _
        LookIn:=LookIn, _
        LookAt:=LookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=MatchCase, _
        SearchFormat:=False)
        If Not c Is Nothing Then
            Set Find_Range = c
            firstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
     
End Function

The code above uses the "Kickbutt VBA Find" function found on http://www.ozgrid.com/forum/showthread.php?t=27240&page=1

Since you wanted to cut and paste the values they need to be done one by one.

 

[Ks1102]

Here's one way to do it:

Sub FindCutAndPaste()
    
Dim c As Range
Dim Rng As Range
Dim Found As Range
Dim Val2BFound As String
    
    
Val2BFound = "X"
    
With Sheet1

    Set Rng = Intersect(.Range("A:A"), .UsedRange) 'Where to look for
    Set Found = Find_Range(Val2BFound, Rng) 'Looking for matching cells

    If Not Found Is Nothing Then
    
    'Matches found:
    'Makes sure the found value is the last value in cell:
        For Each c In Found
            With c
                If Right(.Value, 1) = Val2BFound Then
                'Cut & paste
                    With Sheet2
                        c.Cut Destination:=.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                'if you want other cells to be cut & pasted as well, tweak the "c.cut" bit;
                'c.EntireRow.cut cuts the whole row etc.
                    End With
                End If
            End With
        Next c
    End If

End With

End Sub

Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As Variant, _
    Optional LookAt As Variant, _
    Optional MatchCase As Boolean) As Range
     
    Dim c As Range
    If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
    If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
    If IsMissing(MatchCase) Then MatchCase = False

    With Search_Range
        Set c = .Find( _
        What:=Find_Item, _
        LookIn:=LookIn, _
        LookAt:=LookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=MatchCase, _
        SearchFormat:=False)
        If Not c Is Nothing Then
            Set Find_Range = c
            firstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
     
End Function

The code above uses the "Kickbutt VBA Find" function found on http://www.ozgrid.com/forum/showthread.php?t=27240&page=1

Since you wanted to cut and paste the values they need to be done one by one.

Thanks Misca Very much which work perfectly