Zeilen mit verschiedenen Probennamen kopieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Zeilen mit verschiedenen Probennamen kopieren
von: Benjamin
Geschrieben am: 04.09.2015 12:41:42

Hallo!
Ich soll aus einer sehr großen Liste mit 1600 verschiedenen Proben (und Probennamen) 300 Zeilen herauskopieren die bestimmte (verschiedene) Probennamen haben. Das wäre einfach wenn es nur ein Probenname wäre, aber es sind 300 verschiedene Probennamen.
Die Probennamen habe ich, hab das auch schon mit Spezialfilter probiert, bekomme da aber jedesmal den Fehler: Fehlender oder ungültiger Feldname im Zielbereich.
Mit VBA und Makros kenne ich mich überhaupt nicht aus.
Wäre extrem dankbar über jede Hilfe.
Ich habe ein Beispiel hochgeladen:
https://www.herber.de/bbs/user/100016.xlsx
Zum Beispiel will ich jetzt für die Probennamen a,c,e,g,h,k,l,z,ba,bc die ganzen Zeilen herauskopiert haben. Das habe ich nicht hingekriegt.
lg und Danke!
Benny

Bild

Betrifft: AW: Zeilen mit verschiedenen Probennamen kopieren
von: Sebastel
Geschrieben am: 04.09.2015 18:34:39
Hallo Benny,
bevor Du noch einmal auf die Nase bekommst, weil Dein Thema angeblich irgendwo doppelt war, hier ein Script, das Dein Problem lösen sollte.
Um es nutzen zu können, machst Du Folgendes:
Öffne ein Kopie(!) Deiner Tabelle mit den Proben und speichere sie im Format Excel-Arbeitsmappe mit Makros (*.xlsm). Im Menü Ansicht / Makros / Pfeil nach unten findest Du den Makrorecorder (Makro aufzeichnen). Starte den Recorder, klicke einmal unten auf den Tab Tabelle2 (oder eine andere) und beende den Recorder wieder.
Anschließend öffnest Du wieder das Makro-Menü, wählst Makro anzeigen, Makro1 bearbeiten und erhälst den VBA-Code Deines Miniatur-Makros. Diesen löscht Du komplett und ersetzt ihn durch folgenden Code:

Sub Makro_Proben_Auszug()
' Bildschirmausgabe vorübergehend ausschalten (verhindert unnötiges Bildschirmgeflacker)
Application.ScreenUpdating = False
'' Tabelle2 leeren und Formatierung entfernen
Sheets("Tabelle2").Select
Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .Value = ""
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    
'' Suchbegriffe in Tabelle3 auswählen
Sheets("Tabelle3").Select
' Variablendeklaration
Dim strProbe As String
Dim intProbe As Integer
'Letzte belegte Zelle in Spalte A finden
Cells(65000, 1).End(xlUp).Offset(0, 0).Select
' Schleifenzähler definieren
intProbe = ActiveCell.Row
' Schleife mit drei Aufgaben durchlaufen
For i = 1 To intProbe
    strProbe = Cells(i, 1)
'    MsgBox strProbe, , "Zeile " & i
'' Aufgabe 1: Auffinden des Suchbegriffs in Tabelle1
' Variablendeklaration
Dim intZeile, intSpalte As Integer
Dim strAuszug As String
Sheets("Tabelle1").Select
    Range("B1").Select
    Cells.Find(What:=strProbe, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        
        'Zelladresse in Range übertragen und kopieren
        intZeile = ActiveCell.Row
        intSpalte = 27
        Range(Cells(intZeile, 1), (Cells(intZeile, intSpalte))).Select
        Selection.Copy
'' Aufgabe 2: Kopieren der Zeilen nacheinander in Tabelle2
Sheets("Tabelle2").Select
    Cells(i, 1).Select
    ActiveSheet.Paste
'' Aufgabe 3: Aktivieren der Tabelle 3
Sheets("Tabelle3").Select
    
    ' nächsten Schleifendurchlauf aufrufen
Next i
' Schleife beendet
' Cursor positionieren
Sheets("Tabelle1").Select
Cells(1.1).Select
Sheets("Tabelle3").Select
Cells(1.1).Select
' Bildschirm wieder aktualisieren
Application.ScreenUpdating = True
' Abschlussausgabe
Sheets("Tabelle2").Activate
Cells(1.1).Select
MsgBox (i - 1) & " Proben in Tabelle 2 geschrieben", , "Erfolgreich!"
End Sub
WICHTIG: Sollten in Deiner Arbeitsmappe keine drei Tabellen vorhanden sein oder diese andere Namen haben, musst Du entweder soviele Tabllen einfügen, dass tatsächlich drei zur Verfügung stehen, oder die Namen der "Tabelle1" ... im VBA-Code an Deine Tabelle anpassen. Einfachste und sicherste Methode ist STRG+H (Suchen und Ersetzen)
Anschließend kannst Du das Makro_Proben_Auszug über das Makromenü starten.
Was musst in Deiner Tabelle dazu tun?
1.) müssen die erforderlichen Probennamen in die Spalte A der Tabelle3 eingetragen sein.
2.) dürfen die Tabelle2 und ...3 nicht anderweitig verwendet werden.
3.) dürfen die in der Original-Tabelle angelegten Spalten nicht über die Spalte AB hinausgehen.
Dann sollte alles funktionieren ...
Schöne Grüße
Sebastel
p.s. Ich habe versucht den VBA-Code möglichst so zu kommentieren, dass er in seiner Logik nachvollziehbar ist. Alle Zeilen, die mit einem ' anfangen, sind solche Kommentare
p.p.s. Ich freue mich über jede Rückmeldung ...

Bild

Betrifft: nicht "angeblich", lesen hilft....oT
von: robert
Geschrieben am: 05.09.2015 13:54:17


Bild

Betrifft: 'Auf die Nase' bekommt er nun ja nichts, ...
von: Luc:-?
Geschrieben am: 05.09.2015 16:04:25
…Sebastel;
es ist hier aber im Interesse der Archiv-(Nach-)Nutzer üblich, AnfragenDoppels zu kennzeichnen, damit möglichst alle AWen nur bei einer (idR der 1.) Anfrage gegeben wdn.
Gruß, Luc :-?

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Zeilen mit verschiedenen Probennamen kopieren"