Gefilterte Zellen vergleichen und kopier

Hallo miteinander,
ich brauche eure Hilfe bezüglich Excel VBA. Ich hoffe jemand kann mir, als absoluter VBA-Anfänger, helfen.
Ich erkläre euch nun meine Problematik anhand des angehängten Beispieldatei:
Ich habe im Tabellenblatt "Datenbank" eine (nach Produkttyp in Spalte E) gefilterte Tabelle.
Die ersten Werte aus der ersten sichtbaren Zeile bekomme ich in das erste Tabellenblatt "Bestellvorschlag" herauskopiert. Soweit klappt mein VBA.
Nun möchte ich die folgenden sichtbaren Zellen aus Spalte B allesamt mit der ersten sichtbaren Zelle aus Spalte B vergleichen. Wenn es übereinstimmende Lieferanten gibt (in meinem Beispiel wären es die Zellen B5, B14 und B18), so sollen die dazugehörgen Vertrags_IDs (Spalte A) und die dazugehörigen Mengen (Spalte D) in das erste Tabellenblatt "Bestellvorschlag" kopiert werden. Hierzu gibt es vordefinierte Zellen, in denen die Werte aus der gefilterten Tabelle hinein kopiert werden sollen.
Das Modul soll die nächsten zwei übereinstimmenden Lieferanten finden und die dazugehörigen Daten in das erste Tabellblat "Bestellvorschlag" kopieren.
Ich hoffe ich habe das Problem verständlich erklärt und ein Experte unter euch kann mir weiterhelfen.
Hier ist die Beispieldatei: https://www.herber.de/bbs/user/149776.xlsx
Liebe Grüße
Max

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
dieses Makro wird durch DoubleKlick in der Datenbank gestartet und überträgt die Daten in das Bestellblatt. Bitte testen ob es einwandfrei funktioniert.
mfg Piet

Option Explicit
Dim a As Long, lz1 As Long
Dim e As Long, f As Long


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Worksheets("Bestellvorschlag")
'Bestellung 1-3 löschen
.Range("B2:B4").ClearContents
.Range("B7:B9").ClearContents
.Range("B12:B14").ClearContents
'1. gefilterte Zelle suchen
lz1 = Range("A1").End(xlDown).Row
For a = 2 To lz1 + 1
If Rows(a).EntireRow.Hidden = False Then Exit For
Next a
If a > lz1 Then MsgBox "Es liegt keine Auswahl vor!": Exit Sub
'Bestellung 1 ausfüllen
.Cells(2, 2).Value = Cells(a, 1).Value
.Cells(3, 2).Value = Cells(a, 2).Value
.Cells(4, 2).Value = Cells(a, 4).Value
'2. gefilterte Zelle suchen
For e = a + 1 To lz1 + 1
If Rows(e).EntireRow.Hidden = False Then Exit For
Next e
If e > lz1 Then Exit Sub
'Bestellung 2 ausfüllen
.Cells(7, 2).Value = Cells(e, 1).Value
.Cells(8, 2).Value = Cells(e, 2).Value
.Cells(9, 2).Value = Cells(e, 4).Value
'3. gefilterte Zelle suchen
For f = e + 1 To lz1 + 1
If Rows(f).EntireRow.Hidden = False Then Exit For
Next f
If f > lz1 Then Exit Sub
'Bestellung 3 ausfüllen
.Cells(12, 2).Value = Cells(f, 1).Value
.Cells(13, 2).Value = Cells(f, 2).Value
.Cells(14, 2).Value = Cells(f, 4).Value
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Gefilterte Zellen vergleichen und kopier

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread