Tab.1 filtern,Kopieren und in Tab.2 einfügen
11.03.2009 16:06:48
Ünal
ich bin ein 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.
Tabellenblatt 1
Name Mustermann 1
Vorname Hans 1
Telefon 111
Mobile 1111
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
Tabellenblatt 2
Vorname PLZ Mailadresse
Hans 1 10101 Musterman1@-muster.de
Hans 2 20202 Musterman2@-muster.de
Hans 3 30303 Musterman3@-muster.de
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