In volgende code zit een foutje maar ik kijk er over

Status
Niet open voor verdere reacties.

gast0660

Terugkerende gebruiker
Lid geworden
28 dec 2010
Berichten
4.530
Hallo iedereen
In volgende code zit een foutje, maar ik kijk erover

Code:
Sub SearchForString()

    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer
    Dim LSearchValue As String
    
    On Error GoTo Err_Execute
    
    LSearchValue = InputBox("Vul de naam van de technieker in:", "Technieker")
    
    'Start search in row 4
    LSearchRow = 6
    
    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 2
    
    While Len(Range("A" & CStr(LSearchRow)).Value) > 0
        
        'If value in column E = LSearchValue, copy entire row to Sheet2
        If Range("F" & CStr(LSearchRow)).Value = LSearchValue Then
            
            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy
            
            'Paste row into Sheet2 in next row
            Sheets("Sheet2").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
            
            'Go back to Sheet1 to continue searching
            Sheets("Sheet1").Select
            
        End If
        
        LSearchRow = LSearchRow + 1
        
    Wend
    
    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select
    
    MsgBox "Filtering is compleet."
    
    Exit Sub
    
Err_Execute:
    MsgBox "Oops, iets is fout."
    
End Sub
IK voeg het excel bestandje toe als bijlage.
Maar het probleem is dat als ik de naam dirk invul (knop filter in Sheet 1) ik normaal 5 x dirk zou moeten hebben in sheet 2, en krijg er maar twee, ik kan de fout niet echt vinden.
Alle hulp is welkom

Greetz
 

Bijlagen

Tsja...

Code:
Sub M_snb()
    With Blad1.Cells(1).CurrentRegion
       .Offset(, 19).Resize(2, 1) = .Columns(6).Resize(2).Value
       .Cells(1).Offset(1, 19) = "Dirk"
       .AdvancedFilter 2, .Offset(, 19).Resize(2, 1), Blad2.Cells(Rows.Count, 1).End(xlUp).Offset(4)
       .Offset(, 19).Resize(2, 1).ClearContents
    End With
End Sub

Kijk voor je overige plannen eens op http://www.snb-vba.eu/VBA_Excelgegevens_mailen.html
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan