Hvis ABC i kolonne B - Kopier række til Ark 2.

Prøv at se om du kan bruge vedhæftede.

http://gupl.dk/709915/

Hej Egmose

Er problemet blevet løst?

Skriv i
Autofilter:
indeholder *abc*

Jeg ville bruge VBA og slette vha. autofilterfunktion:

1. Flyt først alle rækker til ark 2

2. slet vha. autofilter sat på din kolonne med slettekriterie:

    Sub Slet() 'I dette eksempel er kolonnen med slettekriterie kolonne H:
   
        Dim RkNr As Long
        Dim calcmode As Long
         
                With Application
                    calcmode = .Calculation
                    .ScreenUpdating = False
                    .Calculation = xlCalculationAutomatic
                End With
               
                RkNr = Range("A2").CurrentRegion.Rows.Count
               
                'Her er fomlen der bestemmer hvad der skal slettes:
                Range("H1:H" & RkNr).FormulaLocal = "hvis(venstre(a1;3)=""abc"";1;0)"
                    Range("H1:H" & RkNr) = Range("H1:H" & RkNr).Value
                   
                With Application
                    .Calculation = xlCalculationManual
                End With
                   
                '**SORTERING SPEEDER RESTEN AF PROCEDUREN OP **
                    RkNr = Range("A2").CurrentRegion.Rows.Count
                With ActiveSheet
                    .Range("A2:H" & RkNr).Sort Key1:=.Range("H1"), Order1:=xlDescending
                End With
                '**SORTERING SLUT**
       
                    Dim Slettevaerdi As String
                    Dim Rng As Range
           
                    Slettevaerdi = 0
           
                    With ActiveSheet
                        .AutoFilterMode = False
                        .Range("H1:H" & Rows.Count).AutoFilter Field:=1, Criteria1:=Slettevaerdi
           
                        With .AutoFilter.Range
                            On Error Resume Next
                            Set Rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                                    .SpecialCells(xlCellTypeVisible)
                            On Error GoTo 0
                            If Not Rng Is Nothing Then Rng.EntireRow.Delete
                        End With
           
                        .AutoFilterMode = False
                    End With
           
                    With Application
                        On Error Resume Next
                            .ScreenUpdating = True
                            .Calculation = calcmode
                        On Error GoTo 0
                    End With
           
                    Range("H:H").Delete 'sletter kriteriekolonne igen
                    Range("A1").Select
       
    End Sub