Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen

Auszugsmacro gesucht

Betrifft: Auszugsmacro gesucht von: Sapoot
Geschrieben am: 18.09.2004 15:44:10

Hallo zusammen...

Ich bin auf der Suche nach einem Macro, der einen Auszug nach vordefinierten Suchkriterien in einem neuem Sheet erstellt.
Er sollte diese Funktion wie der Daten-Filter+Kopieren erfüllen.

Formelbeispiel hab ich auch schon gefunden:

https://www.herber.de/forum/index.htm?https://www.herber.de/forum/archiv/308to312/t310335.htm

Aaaaaalso......
Ich habe einen Sheet mit mehr als 10000 Zeilen. Inhalt sind Partnummern, Bezeichnungen und Seriennummern. Möchte jetzt einen Auszug von mehreren Partnummer,die in einem anderem Sheet zusammengestellt sind, in einer Übersicht haben, natürlich hinten dran die Bezeichnung und die Seriennummern.

Diesen Umstand mit Daten-Filter und Kopieren will ich mir sparen, daher die Suche nach einem Macro.

Danke jetzt schon für die Bemühung

  


Betrifft: AW: Auszugsmacro gesucht von: Willie
Geschrieben am: 22.09.2004 07:06:09

Hallo Sapoot

So sollte es funktionieren: Die Suche über die Spalte A und kopiert die Wert der
Spalte A B D und D auf das Blatt 2 untereinander
Gruß

Willie
Rückmeldung wäre nett auch im Sinne des Forum. Bei Fragen einfach nochmal melden!
Sub suchenundkonsolidieren()
i = 1
With Worksheets(1).Range("a1:a10500")
Suche = InputBox("Bitte Seriennummer eingeben", "Suche")
    Set c = .Find(Suche, LookIn:=xlValues)
        If Not c Is Nothing Then
        firstAddress = c.Address
        Do
        Sheets("Tabelle2").Cells(i, 1).Value = Sheets("tabelle1").Cells(c.Row, 1).Value
        Sheets("Tabelle2").Cells(i, 2).Value = Sheets("tabelle1").Cells(c.Row, 2).Value
        Sheets("Tabelle2").Cells(i, 3).Value = Sheets("tabelle1").Cells(c.Row, 3).Value
        Sheets("Tabelle2").Cells(i, 4).Value = Sheets("tabelle1").Cells(c.Row, 4).Value
            i = i + 1
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End Sub



  


Betrifft: Daaaaanke von: Sapoot
Geschrieben am: 22.09.2004 16:52:28

Hallo.....

Danke für die Antwort, werde Macro demnächst mal ausprobieren. Muss erst mal sehen wie das so funzt mit VBA.

Danke
Sapoot