suchen und kopieren zwei Kriterien

Bild

Betrifft: suchen und kopieren zwei Kriterien
von: Gisela
Geschrieben am: 25.04.2005 16:41:52
Hallo,
ich versuche mit folgendem Makro Zeilen mit zwei Kriterien zu suchen und bei Übereinstimmung in ein anderes Tabellenblatt zu kopieren.
Der Makro funktioniert so wie er jetzt besteht.
Ich brauche aber zwei Änderungen - die ich leider selber nicht hinbekomme-
Das erste Kriterium, im Beispiel "111", soll aus einer Zelle eines Tabellenblattes kommen, z.B. Tabelle12!a3.
Mein zweites Problem in der zweiten Abfrage ist, es soll nicht wie im Beispiel "1" gesucht werden, sondern wenn kein Eintrag. Wenn ich aus "1" aber "" mache, bewegt sich nichts.
Hier main Makro:


Sub SuchenUndKopieren()
Dim wksQ As Worksheet   'Quell-Tabelle
Dim wksZ As Worksheet   'Ziel-Tabelle
Dim rng As Range
Dim lngQ As Long
Dim lngz As Long
   
Set wksQ = Sheets("Aktuell")
Set wksZ = Sheets("VBLKopie")
lngQ = wksQ.Range("AN2000").End(xlUp).Row
lngz = wksZ.Range("A500").End(xlUp).Row + 1
   
   For Each rw In wksQ.Rows
   'sucht in Spalte AN
   If rw.Cells(40).Value = "111" Then 'der Wert sollte aus einer Zelle kommen
End If
'und in Spalte Q
   If rw.Cells(17).Value = "1" Then  'hier soll das Kriterium "" (kein Eintrag)
    
      rw.EntireRow.Copy wksZ.Cells(lngz, 1)
      lngz = lngz + 1
      End If
   Next
      
End Sub

Vielen Dank für jeden Tipp und jede Hilfe
Grüße
Gisela
Bild

Betrifft: AW: suchen und kopieren zwei Kriterien
von: Christoph M
Geschrieben am: 25.04.2005 19:22:08
Hallo Gisela
so zB:

Option Explicit
Sub SuchenUndKopieren()
   Dim wksZ As Worksheet                     'Ziel-Tabelle
   Dim varValue As Variant                   'Übergabe-Wert
   Dim lngCnt As Long, lngZ As Long
   Set wksZ = Sheets("VBLKopie")
   lngZ = wksZ.[A500].End(xlUp).Row + 1
   varValue = Sheets("Tabelle12").[A3].Value
   With Sheets("Aktuell")
      For lngCnt = 1 To .[AN2000].End(xlUp).Row
         If .Cells(lngCnt, 40).Value = varValue And _
            .Cells(lngCnt, 17) = "" Then
            .Rows(lngCnt).Copy wksZ.Cells(lngZ, 1)
            lngZ = lngZ + 1
         End If
      Next
   End With
   Set wksZ = Nothing
End Sub
Gruß
Christoph
Bild

Betrifft: AW: suchen und kopieren zwei Kriterien
von: Gisela
Geschrieben am: 25.04.2005 19:34:40
Hallo Christoph,
vielen Dank, das funktioniert genauso, wie ich es brauche.
schöne Grüße
Gisela
 Bild

Beiträge aus den Excel-Beispielen zum Thema "suchen und kopieren zwei Kriterien"