finden und automatisch übertragen

hi hier roland,

habe ein tabellen blatt "Namen" in einer mappe Muster.xls in dem in zwei spalten z. b. B und D
(die tabelle hat 12 spalten mit div. anderen einträgen)verschiedene namen eingetragen sind.

z. b. B - heinz - D hans .......eine zeile
e. b. B - otto - D heinz ......nächste zeile
usw.

ich will nun alle zeilen die den namen z. B. heinz einthalten, (dieser kan in B oder D auftauchen in eine andere mappe z. B.
Liste.xls kopieren wobei dort in dermappe die tabelle den namen in dem fall " Heinz " heisst.

nun will ich eben eine button ..oder formular haben in dem ich heinz z. b. eingebe und dann sollten alle zeilen in denen heinz vorkommt in die andere mappe in die tabelle mit dem namen "heinz" übertragen...bzw kopieren .

in der mappe muster wird dir tabelle namen immer weiter ausgefüllt (weitere Zeilen)

so dass ich immer wieder die mappe "liste" aktualisieren will.

elegant wäre eventuell wenn ich im eingabefeld den namen nicht schreiben müsste sondern durch anklicken einer zelle die den namen z. b. heinz enthält ...eintragen könnte und dann die aktion ausführen.

eventuel wäre einfacher ich könnt mittels commandbutton erwirken dass B un D nach namen durchsucht wird ....und für jeden namen dann in die jeweilige tabelle in mappe liste.xls
alle zeilen kopiert in denen in spalte B oder D der der gefundene name vorkommt.

sorry für den langen text.

eventuell verlange ich zuviel weil das beschriebene eine komplette problemlösung darstellt..? hmmm

im voraus vielen dank wenn sich jemand dieser problematik annimmt und den entsrechenden code schreibt....

gruss roland_k

Ps. ich habe schon beiträge unter roland eingegeben aber zum unterscheiden will ich in zukunft den namen roland_k benutzen.

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Roland,
wenn ich deine Beschreibung richtig interprtiere, sollte es so funktionieren.

Option Explicit
Sub aktuallisieren()
Dim Arbeitsmappe As Workbook, gefunden As Boolean, Tabelle As Worksheet, TabelleI As Worksheet
Dim Tabellennamen As String, Zeile As Long, letzteZeile As Long, ZeileI As Long, Spalte As Integer
Application.ScreenUpdating = False
Set Tabelle = ThisWorkbook.Sheets("Namen")
For Each Arbeitsmappe In Workbooks
If Arbeitsmappe.Name = "Liste.xls" Then gefunden = True
Next Arbeitsmappe
If Not gefunden Then
Workbooks.Open "D:\Eigene Dateien\Fremde Tabellen\Liste.xls"
Else
Workbooks("Liste.xls").Activate
End If
For Each TabelleI In Workbooks("Liste.xls").Sheets
TabelleI.Cells.ClearContents
Tabellennamen = Tabellennamen & TabelleI.Name & ","
Next TabelleI
If Tabelle.Range("B65536").End(xlUp).Row > Tabelle.Range("D65536").End(xlUp).Row Then
letzteZeile = Tabelle.Range("B65536").End(xlUp).Row
Else
letzteZeile = Tabelle.Range("D65536").End(xlUp).Row
End If
For Zeile = 1 To letzteZeile
For Spalte = 2 To 3
If Tabelle.Cells(Zeile, Spalte) <> "" Then
If InStr(1, Tabellennamen, Tabelle.Cells(Zeile, Spalte)) = 0 Then
Worksheets.Add
ActiveSheet.Name = Tabelle.Cells(Zeile, Spalte)
Tabellennamen = Tabellennamen & Tabelle.Cells(Zeile, Spalte) & ","
End If
If Cells(1, Spalte) = "" Then
ZeileI = 1
Else
If Spalte = 2 Then
ZeileI = Range("B65536").End(xlUp).Row + 1
Else
ZeileI = Range("D65536").End(xlUp).Row + 1
End If
End If
Tabelle.Rows(Zeile).Copy
Rows(ZeileI).PasteSpecial Paste:=xlValues
End If
Next
Next
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
Workbooks("Liste.xls").Save
End Sub

Den Pfad zur Mappe "Liste" musst du noch anpassen.
Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

finden und automatisch übertragen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread