431 Aufrufe
Gefragt in Windows 7 von milli24 Einsteiger_in (86 Punkte)
Guten Tag zusammen. Stehe mal wieder vor einer für mich ungelösten Aufgabe. Ich möchte in dem u.a. Kopier-Code Werte/Text in Zeilen (z.B."SZ") aus Spalte "M" nicht mit übernehmen. Also Wert in Tabelle "ArbTab" in Spalte "M" mit dem Eintrag "SZ" nicht in Tabelle "ZuZa" übernehmen. Mein Versuch am Ende des VBA Codebeispiels funktioniert nicht. Kann mir da jemand aktiv weiter helfen? Danke

Private Sub Zuza()   ' Die Tabelle Zuzahlung
Dim zeile As Long
Dim zeilemax As Long
Dim i As Long
With Worksheets("Zuza")
Worksheets("Zuza").Range("A1:z300").ClearContents  ' LÖSCHEN der alten Daten???????
Worksheets("ArbTab").Range("b:b").Copy Destination:=Worksheets("Zuza").Range("a1")    ' Nummer
Worksheets("ArbTab").Range("d:d").Copy Destination:=Worksheets("Zuza").Range("b1")    ' Name
Worksheets("ArbTab").Range("e:e").Copy Destination:=Worksheets("Zuza").Range("c1")    ' Vorname
   Worksheets("ArbTab").Range("v:v").Copy
    Worksheets("Zuza").Range("d1").PasteSpecial Paste:=xlValues                              ' Betrag
   Worksheets("ArbTab").Range("w:w").Copy
   Worksheets("Zuza").Range("e1").PasteSpecial Paste:=xlValues                              ' Unterschrift
Worksheets("ArbTab").Range("n:n").Copy Destination:=Worksheets("Zuza").Range("f1")    ' Gruppe

    zeilemax = .UsedRange.Rows.Count
    N = 1
        End With
        
ThisWorkbook.Worksheets("ArbTab").Activate
ActiveSheet.UsedRange.AutoFilter
ActiveSheet.UsedRange.AutoFilter 21, "<>SZ"

End Sub

9 Antworten

+1 Punkt
Beantwortet von m-o Profi (22.7k Punkte)
Bearbeitet von m-o

Hallo Milli,

schau mal, ob ich dich richtig verstanden habe:

Sub Zuza()   ' Die Tabelle Zuzahlung

Dim lnglZeile As Long

Worksheets("Zuza").Range("A1:Z300").ClearContents  ' LÖSCHEN der alten Daten???????

With Worksheets("ArbTab")
   'Letzte Zeile in Spalte C ermitteln
    lnglZeile = .Cells(Rows.Count, 1).End(xlUp).Row

   With .Range(.Cells(1, 1), .Cells(lnglZeile, 23))      'Spalten A bis W - ggf. anpassen
    .AutoFilter Field:=13, Criteria1:="<>SZ"              'Filter für Spalte M setzen
   End With
    'nur sichtbare - nicht gefilterte Zellen - kopieren
    .Range("b:b").Cells.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Zuza").Range("a1")    ' Nummer
    .Range("d:d").Cells.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Zuza").Range("b1")    ' Name
    .Range("e:e").Cells.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Zuza").Range("c1")    ' Vorname
    .Range("v:v").Cells.SpecialCells(xlCellTypeVisible).Copy
         Worksheets("Zuza").Range("d1").PasteSpecial Paste:=xlValues                              ' Betrag
    .Range("w:w").Cells.SpecialCells(xlCellTypeVisible).Copy
         Worksheets("Zuza").Range("e1").PasteSpecial Paste:=xlValues                              ' Unterschrift
    .Range("n:n").Cells.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Zuza").Range("f1")    ' Gruppe
End With

End Sub

Gruß

M.O.

0 Punkte
Beantwortet von milli24 Einsteiger_in (86 Punkte)
Danke M.O. funktioniert prima. Einzig die Filterfunktion bleibt in der ersten Zeile stehen. Die Funktion verschwindet doch eigentlich?  Gruß Milli
+1 Punkt
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Milli,

da hatte ich vergessen, den Filter wieder aufzuheben.

Ergänze für End Sub noch die Zeile:

Worksheets("ArbTab").ShowAllData    'Filterung wieder aufheben

Gruß

M.O.

0 Punkte
Beantwortet von milli24 Einsteiger_in (86 Punkte)
Danke, habe den Codetext unten zwischen "End With und "End Sub geschrieben, funktioniert aber nicht????

Mache ich da vielleicht etwas falsch?  Gruß Milli
+1 Punkt
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Milli,

es ist Montag und ich bin wohl noch nicht ganz aufnahmefähig sad.

Du willst ja, dass der Filter auch wieder entfernt wird und nicht nur, dass die Filterung aufgehoben wird.

Füge die folgenden Zeilen vor dem End Sub ein (und lösche die Zeile aus meiner Antwort oben):

With Worksheets("ArbTab")
  .ShowAllData    'Filterung wieder aufheben
  .Range(.Cells(1, 1), .Cells(lnglZeile, 23)).AutoFilter   'Filter entfernen
End With

Gruß

M.O.

0 Punkte
Beantwortet von milli24 Einsteiger_in (86 Punkte)
Danke vielmals, jetzt passt es natürlich perfekt! Gruß und nochmals Danke Milli
0 Punkte
Beantwortet von milli24 Einsteiger_in (86 Punkte)
Hallo nochmal. Die Auswahl passt perfekt, aber wenn ich die Daten aktualisiere hackt es sofort. Die Aktualisierung der anderen Tabellen wird blockiert. Hatte den Versuch erst später gestartet. Gruß Milli
0 Punkte
Beantwortet von milli24 Einsteiger_in (86 Punkte)

Hallo hier die Beispieldatei

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo Milli,

was mir auffällt, ist dass die Variable rngRow leer ist. In deinem ursprünglich geposteten Code war diese nicht enthalten. Diese müsste ja im Makro Private Sub cmdSave_Click() deklariert werden, wenn ich das richtig sehe.

Gruß

M.O.
...