Hallo zusammen,
ich bin ein blutiger Anfänger was VBA angeht. Ich habe mir immer durch die hilfreichen Forums helfen können. Doch zu meiner jetzigen Frage habe ich noch kein Antwort gefunden .
Ich kopiere aus mehreren Text Dateien die Inhalte auf ein Excel-Tabellenblatt (1) Untereinander.
Das funktioniert auch.
In das Tabellenblatt (2) möchte ich nur gewisse Informationen aus Tabellenblatt (1) übertragen.
Das funktioniert nicht, bzw ich habe etwas zusammengebastelt was aber nicht funktioniert.
Tabelle 1 / Tabelle 2
/
Name Mustermann 1 / Vorname PLZ Mailadresse
Vorname Hans 1 / Hans 1 1010 Musterman1@-muster.de
Telefon 111 / Hans 2 20202 Musterman2@-muster.de
Mobile 1111 / Hans 3 30303 Musterman3@-muster.de
PLZ 10101 /
mailadresse Musterman1@-muster.de /
/
/
Vorname Hans 2 /
Adresse Musterstrasse 2 /
Geb.datum 02.02.2002 /
Name Mustermann 2 /
PLZ 20202 /
Telefon 222 /
mailadresse Musterman2@-muster.de /
/
/
Telefon 333 /
Datum 03.03.2003 /
mailadresse Musterman3@-muster.de /
Name Mustermann 3 /
Vorname Hans 3 /
Mobile 3333 /
PLZ 30303 /
/
usw………
Sub test3()
Dim S As String, t As String
'im Tabellenblatt "Tabellenblatt1" nach "Vorname " suchen
'Die Zelle rechts daneben kopieren, Tabellenblatt "Tabellenblat2" wählen
'nach "Vorname " suchen in die nächste leere spaltenzelle einfügen.
' Auswahl Tabellenblatt "............"
Sheets("Tabellenblatt1").Select
' Suche nach "........"
Cells.Find(What:="Vorname", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
'Wähle die Zelle rechts daneben
Cells(ActiveCell.Row, 2).Select
' Kopiere den Zelleninhlt
Selection.Copy
' Auswahl Tabellenblatt "............"
Sheets("Tabellenblatt2").Select
' Suche nach "........"
Cells.Find(What:="Vorname", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
' nächste freie Zelle der Spalte auswählen
S = Cells(1, ActiveCell.Column).Address(0, 0)
With WorksheetFunction
t = .Substitute(S, 1, "")
Range(t & "65536").End(xlUp).Offset(0, 0).Select
ActiveCell.Offset(1, 0).Select
' Füge den kopierten Inhalt ein
ActiveSheet.Paste
End With
End Sub
|