Copied VBA code won't work.

Hello,

With the help of this forum i created a piece of code that searches, matches and copies values. Its working fine. here's the code:

Sub FilterAgents()


Application.ScreenUpdating = False
    UitvoerBlad.Activate
    UitvoerBlad.Unprotect (Constanten.wachtwoord)
    UitvoerBlad.Range("C5:F104").Value = ""

With InvoerBlad.Range("B1", InvoerBlad.Range("B" & Rows.Count).End(xlUp))
    Set c = .Find(What:="Medewerker:", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
            n = UitvoerBlad.Range("C" & Rows.Count).End(xlUp).Row + 1
            v = Application.Match(c.Offset(, 1), UitvoerBlad.Columns("K:K"), 0)
            If IsNumeric(v) Then
                UitvoerBlad.Range("D" & n).Value = Application.Index(UitvoerBlad.Columns("L:L"), v, 1)
                c.Offset(0, 1).Copy
                UitvoerBlad.Range("C" & n).PasteSpecial xlPasteValues
                Set c1 = .Find(What:="Conversie", After:=c, Lookat:=xlWhole, _
                               SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                               MatchCase:=False, SearchFormat:=False)
                Set c2 = InvoerBlad.Cells.Find(What:="Totaal", After:=c, Lookat:=xlWhole, _
                                          SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                          MatchCase:=False, SearchFormat:=False)
                If Not c1 Is Nothing And Not c2 Is Nothing Then
                    InvoerBlad.Cells(c1.Row, c2.Column).Copy
                    UitvoerBlad.Range("E" & n).PasteSpecial xlPasteValuesAndNumberFormats
                    InvoerBlad.Cells(c1.Row + 2, c2.Column).Copy
                    UitvoerBlad.Range("F" & n).PasteSpecial xlPasteValuesAndNumberFormats
                End If
            End If
            Set c = .Find(What:="Medewerker:", After:=c, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
        Loop While c.Address <> firstaddress
    End If
End With
      UitvoerBlad.Protect (Constanten.wachtwoord)
Application.ScreenUpdating = True

End Sub

Now I'm trying to copy and change the code so an other value is searched, here is the code I created.

Sub FilterTeam()


Application.ScreenUpdating = False
    UitvoerBlad1.Activate
    UitvoerBlad1.Unprotect (Constanten.wachtwoord)
    UitvoerBlad1.Range("C5:F104").Value = ""

With InvoerBlad.Range("B1", InvoerBlad.Range("B" & Rows.Count).End(xlUp))
    Set c = .Find(What:="Team:", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
            n = UitvoerBlad1.Range("C" & Rows.Count).End(xlUp).Row + 1
            v = Application.Match(c.Offset(, 1), UitvoerBlad1.Columns("K:K"), 0)
            If IsNumeric(v) Then
                UitvoerBlad1.Range("D" & n).Value = Application.Index(UitvoerBlad1.Columns("L:L"), v, 1)
                c.Offset(0, 1).Copy
                UitvoerBlad1.Range("C" & n).PasteSpecial xlPasteValues
                Set c1 = .Find(What:="Conversie", After:=c, Lookat:=xlWhole, _
                               SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                               MatchCase:=False, SearchFormat:=False)
                Set c2 = InvoerBlad.Cells.Find(What:="Totaal", After:=c, Lookat:=xlWhole, _
                                          SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                          MatchCase:=False, SearchFormat:=False)
                If Not c1 Is Nothing And Not c2 Is Nothing Then
                    InvoerBlad.Cells(c1.Row, c2.Column).Copy
                    UitvoerBlad1.Range("E" & n).PasteSpecial xlPasteValuesAndNumberFormats
                    InvoerBlad.Cells(c1.Row + 2, c2.Column).Copy
                    UitvoerBlad1.Range("F" & n).PasteSpecial xlPasteValuesAndNumberFormats
                End If
            End If
            Set c = .Find(What:="Medewerker:", After:=c, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
        Loop While c.Address <> firstaddress
    End If
End With
      UitvoerBlad1.Protect (Constanten.wachtwoord)
Application.ScreenUpdating = True



End Sub

The code is working fine, the first item is found, matched and placed in the right cell, only the code give's an error at the end "Loop While c.Address <> firstaddress"

Does anyone has got an idea? the code is working in the first part but not in the second.

Thanks in advance

ABBOV

Using advancedfilter would have the same result with a minimum of VBA-code

with InvoerBlad.cells(1,2).currentregion
  .resize(1).offset(,19)=.resize(1).value
  InvoerBlad.cells(2,21)="Team"
  .advancedfilter xlfiltercopy, invoerblad.cells(1,20).currentregion, UitvoerBlad1.cells(1,1)
End With