Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1652to1656
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Namen in Splate suchen und Zeile kopieren
26.10.2018 16:10:23
Martin
Hallo,
ich benötige mal Eure fachkundige Hilfe bei einem Problem.
In einem Tabellblatt(1) soll in einer bestimmten Spalte (z.B. Spalte B) nach einem Namen gesucht werden. Alle Zeilen die den Namen enthalten sollen markiert und in ein neues Tabellenblatt kopiert werden.
Schön wäre es wenn man den Namen über eine Auswahl auswählen kann (sind max. 10 Namen), dann gleichzeitig ein neues Tabellenblatt mit den Namen erzeugt wird in die dann die zuvor markierten Zeilen des Tabellenblatt 1 kopiert werden.
Wäre so etwas möglich?
Vielen Dank im vorraus für Eure Hilfe
MfG
Martin

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Bwnutze den Autofilter...
26.10.2018 16:38:07
Beverly
Hi Martin,
...und kopiere dann die sichtbaren Zeilen. Wie der prinzipielle Code dazu aussieht kannst du mit dem Makrorekorder aufzeichnen.


AW: Bwnutze den Autofilter...
27.10.2018 00:06:11
Beverly
Hi Martin,
Public Sub Kopieren()
Dim objDic As Object
Dim varBereich As Variant
Dim arrDaten As Variant
Dim lngZaehler As Long
' Dictionary erstellen
Set objDic = CreateObject("Scripting.Dictionary")
With Worksheets("Tabelle1")
varBereich = .Range("B2", .Range("B2").End(xlDown))
' ohne Duplikate ins Dictionary übernehmen
For lngZaehler = LBound(varBereich) To UBound(varBereich)
objDic(varBereich(lngZaehler, 1)) = 0
Next
' Werte aus Dictionary an ein Array übergeben
arrDaten = objDic.keys
With Worksheets("Tabelle1")
For lngZaehler = 0 To UBound(arrDaten)
' Autofilter setzen entsprechend laufendem Array-Feld
.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=arrDaten(lngZaehler)
' neue Tabelle erstellen und ans Ende setzen
Worksheets.Add after:=Worksheets(Worksheets.Count)
' Name des letzten Tabellenblattes entsprechend laufendem Array-Feld
Worksheets(Worksheets.Count).Name = arrDaten(lngZaehler)
' gefilterte daten einschließlich Pberscgrift kopieren
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets(Worksheets.Count).Range("A1")
Next lngZaehler
' Autofilter löschen
.Range("A1").CurrentRegion.AutoFilter
End With
End With
' Vairable leeren
Set objDic = Nothing
End Sub

Beachte: es wird nicht geprüft, ob bereits Tabellenblätter mit den entsprechenden Namen vorhanden sind!


Anzeige
AW: Namen in Splate suchen und Zeile kopieren
26.10.2018 16:54:30
Werner
Hallo Martin,
ein paar wenig Infos.
Wo stehen deine Daten in Tabelle1 (von Zeile/Spalte bis Zeile/Spalte)?
Wohin soll kopiert werden (Zielzelle A1)?
Hier mal ein Code. Dabei bin ich davon ausgegangen, dass im Quellblatt die eigentlichen Daten in Zeile 2 beginnen und in Zeile 1 Überschriften vorhanden sind. Zudem bin ich davon ausgegangen, dass du auch Daten in Spalte A hast.
Die Daten werden ins Zielblatt (wird neu erstellt) ab A1 eingefügt.
Public Sub Suchen_kopieren()
Dim loZeile As Long, loSpalte As Long
Dim strSuchbegriff As String, wsBlatt As Worksheet
Application.ScreenUpdating = False
strSuchbegriff = InputBox("Name eingeben:", "Suche nach...")
If Not strSuchbegriff = vbNullString Then
With Worksheets("Tabelle1") 'Blattname anpassen
If WorksheetFunction.CountIf(.Columns(2), strSuchbegriff) = 0 Then
MsgBox strSuchbegriff & " ist in Spalte B nicht enthalten."
Exit Sub
End If
On Error Resume Next
Set wsBlatt = Worksheets(strSuchbegriff)
If Err.Number = 9 Then
On Error GoTo 0
Worksheets.Add , Sheets(Sheets.Count)
ActiveSheet.Name = strSuchbegriff
End If
loZeile = .Cells(.Rows.Count, 2).End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, 1), .Cells(loZeile, loSpalte)).AutoFilter Field:=2, _
Criteria1:=strSuchbegriff
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible).Copy _
Worksheets(strSuchbegriff).Range("A1")
.AutoFilterMode = False
.Activate
End With
End If
End Sub
Gruß Werner
Anzeige
AW: Namen in Splate suchen und Zeile kopieren
26.10.2018 22:54:15
Martin
Hallo Werner,
sieht schon gut aus, aber leider noch ein Fehler drin, ich versuche mal genauer zu definieren.
- Daten stehen ab Zeile 2 von A bis H, Zeile 1 sind die Überschriften
- ich gebe meinen Suchbegríff der in Spalte C steht ein --- ist ok
- es wird ein neues Tabellenblatt erzeugt das den Namen des Suchbegriffs bekommt --- ist ok
- die Routine springt auf das Tabellenblatt (Tabelle 1) wieder zurück
- setzt den Autofilter mit meinem Suchbegriff
- kopiert alle Zeilen incl. Zeile 1 (Überschriften)in das zuvor erzeugte Tabellenblatt
- sind alle Zeilen kopiert wird der Autofilter auf Tabellenblatt1 wieder zurück gesetzt
Hoffe das die Info jetzt etwas genauer sind.
Vorab schon einmal vielen Dank für deine Hilfe
MfG
Martin
Anzeige
AW: Namen in Splate suchen und Zeile kopieren
27.10.2018 00:09:59
Martin
Hallo Martin,
habe den Fehler behoben, funktioniert soweit alles gut.
Jetzt muss nur noch die Überschriftenzeile von Tabellenblatt 1 in das neue Tabellenblatt kopiert werden
Nochmals vielen vielen Dank für Deine Hilfe.
MfG
Martin
AW: Namen in Splate suchen und Zeile kopieren
27.10.2018 10:11:20
Werner
Hallo Martin,
dann so:
Public Sub Suchen_kopieren()
Dim loZeile As Long, loSpalte As Long
Dim strSuchbegriff As String, wsBlatt As Worksheet
Application.ScreenUpdating = False
strSuchbegriff = InputBox("Name eingeben:", "Suche nach...")
If Not strSuchbegriff = vbNullString Then
With Worksheets("Tabelle1") 'Blattname anpassen
If WorksheetFunction.CountIf(.Columns(3), strSuchbegriff) = 0 Then
MsgBox strSuchbegriff & " ist in Spalte C nicht enthalten."
Exit Sub
End If
On Error Resume Next
Set wsBlatt = Worksheets(strSuchbegriff)
If Err.Number = 9 Then
On Error GoTo 0
Worksheets.Add , Sheets(Sheets.Count)
ActiveSheet.Name = strSuchbegriff
End If
loZeile = .Cells(.Rows.Count, 3).End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, 1), .Cells(loZeile, loSpalte)).AutoFilter Field:=3, _
Criteria1:=strSuchbegriff
.AutoFilter.Range.Resize(.AutoFilter.Range.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible).Copy _
Worksheets(strSuchbegriff).Range("A1")
.AutoFilterMode = False
.Activate
End With
End If
End Sub
Gruß Werner
Anzeige
Du hattest...
27.10.2018 12:48:23
Beverly
Hi Martin,
...meinen Beitrag bereits gelesen und den Code auch schon getestet? Eine Rückmeldung deinerseits wäre schon angebracht.


317 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige