Gefilterte Zeilen kopieren in naechstes Blatt in freie Zeile und eingefuegte Zeilen ausblenden
27.11.2019 19:38:09
Chris
ich habe ein Problem mit meinem Makro.
Ich filter Spalte A aus Blatt1 nach dem Wert "x". Danach kopiere ich bestimmte Spalten aus der Zeile mit dem Wert x. Die Daten werden in die nächste freie Zeile in Blatt2 eingefügt. Zu beginn ist Zeile 4 die erste freie Zeile.
Der Vorgang wird durch die Schaltfläche "Auswerten" gestartet. Ich habe hier ein Problem mit der Formatierung. Ich möchte die Werte mit ihrem ursprünglichen Format einfügen.
Nach diesem Vorgang generiere ich eine Outlook E-Mail mit der Excel als .xlsx gespeichert. Das funktioniert wunderbar.
Anschließend drücke ich auf Blatt1 die Schaltfläche "Reset". Diese blendet die eingefügten Zeilen in Blatt 2 aus. Außerdem werden die "x" in Spalte A in Blatt1 entfernt.
Wenn ich nun andere Zeilen in Spalte A Blatt1 mit dem Wert "x" fülle und die Schaltfläche "Auswerten" drücke, überschreibt es die Zeilen in Blatt2. Eigentlich möchte ich, dass das Makro die neuen Werte in die nächste freie Zeile nach den ausgeblendeten Werten einfügt und nicht die alten überschreibt.
Angehängt findet ihr den Code für die beiden Schaltflächen.
Sub Auswerten()
Sheets("Fehlerliste").Select
ActiveSheet.Range("$A$2:$AD$100000").AutoFilter Field:=1, Criteria1:=""
Dim WkSh_Q As Worksheet
Dim WkSh_Z As Worksheet
Set WkSh_Q = ThisWorkbook.Worksheets("Fehlerliste")
Set WkSh_Z = ThisWorkbook.Worksheets("To Do's")
WkSh_Q.Range("C3:E4" & WkSh_Q.Cells(WkSh_Q.Rows.Count, 1).End(xlUp).Row + 1).Copy
WkSh_Z.Range("A" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WkSh_Z.Range("A4:C1000").PasteSpecial _
Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
WkSh_Q.Range("Q3:R1000").Copy
WkSh_Z.Range("D" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 4).End(xlUp).Row + 1).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WkSh_Z.Range("D4:E1000").PasteSpecial _
Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
WkSh_Q.Range("W3:W1000").Copy
WkSh_Z.Range("F" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 6).End(xlUp).Row + 1).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WkSh_Z.Range("F4:F1000").PasteSpecial _
Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
WkSh_Q.Range("Y3:Y1000").Copy
WkSh_Z.Range("G" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 7).End(xlUp).Row + 1).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WkSh_Z.Range("G4:G1000").PasteSpecial _
Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
WkSh_Q.Range("AA3:AA1000").Copy
WkSh_Z.Range("H" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 8).End(xlUp).Row + 1).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WkSh_Z.Range("H4:H1000").PasteSpecial _
Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
WkSh_Q.Range("AD3:AD1000").Copy
WkSh_Z.Range("I" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 9).End(xlUp).Row + 1).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WkSh_Z.Range("I4:I1000").PasteSpecial _
Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
WkSh_Q.Range("F3:F1000").Copy
WkSh_Z.Range("J" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 10).End(xlUp).Row + 1).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WkSh_Z.Range("J4:J1000").PasteSpecial _
Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
WkSh_Q.Range("N3:P1000").Copy
WkSh_Z.Range("K" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 11).End(xlUp).Row + 1).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WkSh_Z.Range("K4:M1000").PasteSpecial _
Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("To Do's").Select
Range("A1").Select
Sheets("Fehlerliste").Select
ActiveSheet.Range("$A$2:$AD$10000").AutoFilter Field:=1
End Sub
Sub Reset()
Sheets("To Do's").Select
'Range("A4:M1000").Select
'Selection.ClearContents
'Selection.ClearFormats
'Sheets("To Do's").Select
'Range("A1").Select
Dim Wiederholungen As Long
Application.ScreenUpdating = False
For Wiederholungen = 1 To 1000
If Cells(Wiederholungen, 1).Value Like "MONITOR*" Or Cells(Wiederholungen, 1).Value Like " _
CLOSED*" Or Cells(Wiederholungen, 1).Value Like "OPEN*" Then
Rows(Wiederholungen).Hidden = True
Else
Rows(Wiederholungen).Hidden = False
End If
Next
Sheets("Masked & IO Error W138").Select
Range("A3:A1000").Select
Selection.ClearContents
Range("A2").Select
End Sub
Vielen Dank für eure Hilfe im Voraus.
Beste Grüße,
Chris