Sammenligne 2 regneark

Er de to regneark ens i opbygningen?
Er de to ark i samme fil - eller..

Det kunne være forskellige mapper, hvor det eneste de to regneark har til fælles er cpr og navn, men resten kunne godt være forskelligt.
Jeg vil gerne kontrollere og cpr og navn er ens i de to regne ark

Det skulle nok kunne lade sig gøre.
Hvordan identificeres de 2 projektmapper - via indtastning - eller?

Jeg forstår ikke helt dit spørgsmål
Men jeg mener ex at jeg har en mappe der hedder medlemmer fodbold og en mapper der hedder medlemmer håndbold. Jeg vil gerne kontrollere hvor mange medlemmer der spiller begge steder.

Ok - det er jo så en lidt anden sag - men det er også muligt.
I hvilke kolonner er cprNr anført i de to mapper?

I kolonne A

Følgende kode indlægges i Ark1 i filen vedr. Fodbold.
(Højreklik på arkfane - vis programkode)
Hvis problemer - send en mail til pb@supertekst-it - så sender jeg mine filer..
===========================

Rem Koden igangsættes fra SUB Optælling - evt. forbindes med en knap
Rem Const-værdierne kan evt. ændres
Rem ===============================
Const startRæk = 2                  'Hvis overskrift
Const håndbold = "Håndbold.xls"    'Navn på mappe for Håndbold

Dim sti, hbXLS, fejlFlag As Boolean, antal
Sub optælling()
Dim cprNr
Rem find sti for de 2 filer (forudsættes at ligge samme sted)
Rem =========================================================
    sti = Findsti
    antal = 0
   
    fejlFlag = False
    åbnHåndbold                        'Åbn xls-mappe f/håndbold
   
    If fejlFlag = False Then
   
        For ræk = startRæk To 65000
Rem udtag cprnr fra Fodbold
            cprNr = Cells(ræk, 1)
           
Rem Fortsæt indsæt tom celle i Kol A mødes
            If cprNr = "" Then
                Exit For
            End If
           
Rem optæl antal hvor cprnr fra fodbold også findes i håndbold
            antal = antal + findCprNr(cprNr)
            If fejlFlag = True Then
                MsgBox ("Fejlkonstateret - kontakt udvikler")
                Exit For
            End If
        Next ræk
       
        MsgBox ("Antal ens cprnr.: " + CStr(antal))
        lukHåndbold
    Else
        MsgBox ("Fejlkonstateret - kontakt udvikler")
    End If
End Sub
Private Function Findsti()
    Findsti = ActiveWorkbook.Path
    If Right(Findsti, 1) <> "\" Then
        Findsti = Findsti + "\"
    End If
End Function
Private Sub åbnHåndbold()
On Error GoTo fejl

    Set hbXLS = CreateObject("Excel.Application")
    With hbXLS
        .Workbooks.Open sti + håndbold
    End With

    Exit Sub
   
fejl:
    fejlFlag = True
End Sub
Private Sub lukHåndbold()
    hbXLS.Application.Quit
    Set hbXLS = Nothing
End Sub
Private Function findCprNr(cprNr)          'findes cprNr i Håndbold
On Error GoTo fejl

    With hbXLS.Range("A" + CStr(startRæk) & ":A65000")
        Set c = .Find(cprNr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findCprNr = 1
        Else
            findCprNr = 0
        End If
    End With
    Exit Function
   
fejl:
    fejlFlag = True
End Function

Afprøvet?

Ja tak
kom med et svar

Selv tak - det får du her...