Office 2007: Zahl aus Zelle kopieren, prüfen und in eine andere Zelle einfügen.

[DennisV]

Hallo  Community, viele Dank für die tolle Hilfestellung die ihr mir bisher gegeben habt. Brauche leider mal wieder  von euch Wink

Ich habe eine Excel Datei mit 9 Spielern/Managern.
Jeder dieser Spieler hat ein eigenes Tabellenblatt.
Da drinn enthalen die Aufstellung die er mit seinen Fussballspieler macht und weiter unten sein kommpleter Kader.
Zur  wurden die Gegentore alle manuell eingetragen doch dies ist sehr Zeitraubend.

Jetzt hab ich ein neues Tabellenblatt "Vereine", dort stehe die Mannschaften der 1. drinne.

Ziel ist es im Tabellenblatt "Vereine" die Gegentore der Mannschaft einmalig einzutragen und per  von Makros diese dann in die jeweiligen Tabellenblätter der Spieler/Manager einzutragen.

Tabellenblatt "Vereine" ist so Aufgebaut:
Ab A2 fangen die Vereine an (Bayern München,  usw.)
Ab B2 stehen die jeweils manuell eingetragenen Gegentore drinne.

Nehmen wir jetzt den Spieler/Manager mit dem Tabellennamen "DV".
Ab E17 fängt sein Kader an, dort stehen die Fussballspieler Namen und bei F17 der dazugehörige Verein (Bei jeden Spieler/Manager gleich)

Bsp. Hannoer hat 3 Gegentore:
Jetzt soll das Makro bei "DV" prüfen ob er einen Spieler von Hannover (F17) hat und diesen Fussballspielernamen (E17), mit seiner Aufstellung (A2-A7) prüfen und bei D2-D7 die Gegentore eintragen.

Hab da schon mal angefangen, nur stehe ich voll auf dem Schlauch und weis nicht mehr Weiter :-(

Code: [Auswählen]

Sub GGTore()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, cell As Range, xell As Range
Set ws1 = Worksheets("Vereine")
Set ws2 = Worksheets("DV")
Set rngToreStart = ws1.Range("A2")
Set rngToreEnd = rngToreStart.End(xlDown)
Set rngVereinStart = ws2.Range("F17")
Set rngVereinEnd = rngVereinStart.End(xlDown)
Set rngKaderStart = ws2.Range("E17")
Set rngKaderEnd = rngKaderStart.End(xlDown)
Set rngAufstellungStart = ws2.Range("A2")
Set rngAufstellungEnd = ws2.Range("A7")

    For Each cell In ws2.Range(rngVereinStart, rngVereinEnd)
        Set foundCell = ws1.Range(rngToreStart, rngToreEnd).Find(cell.Value, LookIn:=xlValues)
            If Not foundCell Is Nothing Then
            cell.Value = foundCell.Offset(0, 1).Value
            End If
        Next

End Sub


[DennisV]

Wurde mit SVerweis gelöst.