Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tab.1 filtern,Kopieren und in Tab.2 einfügen

Tab.1 filtern,Kopieren und in Tab.2 einfügen
11.03.2009 16:06:48
Ünal
Hallo zusammen,
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


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

Betreff
Datum
Anwender
Anzeige
AW: Tab.1 filtern,Kopieren und in Tab.2 einfügen
11.03.2009 18:50:00
fcs
Hallo Ünal,
da die Reihenfolge der Informationen in den Datensätzen wechselt, kann man nicht so einfach nach dem nächsten Vornamen suchen und dann die zugehörigen anderen Daten suchen (Richtung oben oder unten?)
Wenn zwischen jedem Datensatz eine oder mehrere leere Zeilen sind, dann kann man diese Systematik nutzen.
Makro sieht dann z.B. so aus:
Gruß
Franz

Sub test2()
Dim wksText As Worksheet, wksListe As Worksheet
Dim lngZeileText As Long, lngZeileListe As Long
Dim bolDatensatz As Boolean
Set wksText = Worksheets("Tabelle1") 'Tabelle mit Daten aus Textdateien
Set wksListe = Worksheets("Tabelle2") 'Tabelle mit neuer Liste
lngZeileListe = 2
With wksText
For lngZeileText = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(lngZeileText, 1) = "" And bolDatensatz = True Then
lngZeileListe = lngZeileListe + 1
bolDatensatz = False
ElseIf .Cells(lngZeileText, 1) = "" And bolDatensatz = False Then
'do nothing, weitere Leerzeile zwischen 2 Datensätzen
ElseIf .Cells(lngZeileText, 1)  "" Then
bolDatensatz = True
'Begriff in Spalte 1 vergleichen
Select Case LCase(.Cells(lngZeileText, 1).Value)
Case "vorname"
'Vorname in Spalte A (1) eintragen
wksListe.Cells(lngZeileListe, 1).Value = .Cells(lngZeileText, 2).Value
Case "adresse"
'do nothing
Case "geb.datum"
'do nothing
Case "name"
'do nothing
Case "plz"
'PLZ in Spalte B (2) eintragen (wegen PLZ mit 0 am Anfang das Hochkomma  _
voranstellen!)
wksListe.Cells(lngZeileListe, 2).Value = "'" & .Cells(lngZeileText, 2).Text
Case "telefon"
'do nothing
Case "mailadresse"
'e-Mailadresse in Spalte C (3) eintragen
wksListe.Cells(lngZeileListe, 3).Value = "'" & .Cells(lngZeileText, 2).Text
Case "datum"
'do nothing
Case "mobile"
'do nothing
Case Else
'do nothing
End Select
End If
Next
End With
End Sub


Anzeige
AW: Tab.1 filtern,Kopieren und in Tab.2 einfügen
11.03.2009 21:19:11
Ünal
Hallo Franz,
vielen Dank für den Vorschlag. Er ist absolut ausreichend für meinem vorhaben.
Viele Grüsse
Ünal

312 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige