Zeichenfolgen aus Zellen suchen und übertragen

Hallo Leute,
ich mal wieder... :-P
Suche eine Lösung, wie Verantwortliche aus einem Tabellenblatt in ein Anderes Kopiert weren, indem die Zeichenfolgen der Themen verglichen werden....
In meiner Datei gibt es ein Tabellenblatt "Eingabe Agenda", eines "Eingabe Ansprechpartner" (Projekte und/oder Ansprechpartner ändern sich regelmäßig, daher extra Blatt) und ein "Mitschrift-Master" als Kopiervorlage...
nach Aktivieren des CommandButtons wird die Agenda bereinigt und die TOP´s und Themen in einzelne neu zu erstellende Arbeitsblätter kopiert. Ich hätte auch gern die Ansprechpartner mit Telefonnummer neben den Agendathemen und in Feld E4 des jeweiligen Blattes dazu.... Bei Nichtübereinstimmung wären drei rote Fragezeichen nett. Weiß aber nicht wie. Wer kann mir helfen?
Folgend der Upload einer abgestrippten Bsp.-Datei:
https://www.herber.de/bbs/user/68725.xls
Danke & Gruß
Sven

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Sven,
das ist nur möglich, wenn du im Thema das Projekt mit einträgst und zwar exakt so geschrieben wie in Spalte B des Blatt "Eingabe Ansprechpartner". Einfacher (Schreibfehler werden vermieden) ist es wahrscheinlich, das Projekt auf der Agenda in einer separaten Spalte einzutragen. Dann kannst du eine Datengültigkeitsprüfung -ggf. mit Drop-Down- einbauen.
Ein Makro hierfür sieht etwa wie folgt aus.
Gruß
Franz

Sub Ansprechpartner()
'Ansprechpartner ermitteln
Dim wksAnsprech As Worksheet
Dim wksAgenda As Worksheet
Dim lngZeile&, lngZeile2&, sThema$
Set wksAgenda = Worksheets("Eingabe Agenda")
Set wksAnsprech = Worksheets("Eingabe Ansprechpartner")
With wksAgenda
'Schleife bis letzte Zeile Spalte A
For lngZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Cells(lngZeile, 1)  "" Then
sThema = .Cells(lngZeile, 3).Text
bGefunden = False
For lngZeile2 = 2 To wksAnsprech.Cells(.Rows.Count, 2).End(xlUp).Row
If InStr(1, sThema, wksAnsprech.Cells(lngZeile2, 2).Text) > 0 Then
bGefunden = True
Exit For
End If
Next lngZeile2
If bGefunden = True Then
.Cells(lngZeile, 4).Value = wksAnsprech.Cells(lngZeile2, 8) & " - Tel. " _
& wksAnsprech.Cells(lngZeile2, 9) 'Name + Telefon
Else
.Cells(lngZeile, 4).Value = "? - ?"
End If
End If
Next
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Zeichenfolgen aus Zellen suchen und übertragen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

319 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeichenfolgen aus Zellen suchen und übertragen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

319 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread