Excel 2010 VBA For-chleife in For-Schleife

[Nico_B]

Guten Morgen.

Ich habe Excel Arbeitsmappe mit mehreren Tabellenblättern. Auf einem Tabellenblatt ("Daten") werden die Daten mit Formeln zusammengefasst. Nun sollen Einzelwerte ausgewertet werden. Hierzu beständ die Möglichkeit dies mit Filtern und Ausblenden zu machen. Da dies jedoch als sehr müselig erweisen kann. Werden in der inneren Schleife die Werte auf ein seperates Tabellenblatt kopiert und werden dann ausgedruck, um es den jeweiligen Verantwortlichen zur Verfügung zu stellen.

Nun soll in er zweiten spalte für jeden bereich gemacht werden. leider kommt es zu fehlern hierbei. vielleicht könnt ihr mir ja helfen.

Sub einzelwertedrucken()

    ' Bestätigungsabfrage
    g = MsgBox("Druckvorgang starten?", vbYesNo, "Sicherheitsabfrage")
    If g = vbNo Then Exit Sub Else
     For f = 18 To 22
     ' Quellbereich darf nicht Leer sein
     If (Sheets("Optionen").Cells(f, 1).Value <> "") Then
         Sheets("Optionen").Cells(f, 1).Copy
         'Einfügen
         Sheets("Ergebnis").Range("C3").PasteSpecial xlPasteAll
         
         Dim i As Long, j As Long
        Dim MUE1 As Long, MUE2 As Long
        Dim sw As Variant
        
        sw = Worksheets("Ergebnis").Range("C3").Value ' Bedingung fürs kopieren
        j = 6 ' erste Zeile in der die Daten eingefügt werden sollen
        
        ' Umfang des Datenbereichs
        MUE1 = Worksheets("Parameter").Range("D18").Value
        MUE2 = Worksheets("Parameter").Range("D19").Value
                  
         Application.ScreenUpdating = False
         Sheets("Ergebnis").Range("A6:D1000").Delete
         
        ' Tabellenblatt wo die Ausgangsdaten sich befinden
        With Worksheets("Daten")
            For i = MUE1 To MUE2
                If .Cells(i, 15) = sw Then
                    Union(.Range("E" & i & ":F" & i), .Range("X" & i), .Range("AB" & i)).Copy _
                         Destination:=Worksheets("Ergebnis").Range("A" & j) 'Zielbereich auf dem neuen Tabellenblatt
                    j = j + 1
                End If
            Next i
        End With

        Application.ScreenUpdating = True

         ' Ausdrucken
         Sheets("Ergebnis").PrintOut
     End If
     ' Nächste Zelle überprüfen
     Next

End Sub

 

[DocWindows]

Ups, verlesen.

 

[Nico_B]

habs gelöst mit 2 makro. das eine ruft das andere auf. ^^