Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeile kopieren, wenn Bedingung erfüllt

Zeile kopieren, wenn Bedingung erfüllt
14.11.2019 08:58:25
Jessica
Hallo
ich bräuchte Hilfe bei einem Problem.
Ich habe eine Excel Tabelle mit einigen Tabellenblättern. Es sollen aus allen Tabellenblättern die Zeilen in ein extra Tabellenblatt kopiert werden, die einer bestimmten Kalenderwoche entsprechen. Ich habe bereits ein funktionierendes Makro geschrieben. Allerdings funktioniert es nur, solange in allen Tabellenblättern mind. eine Zeile mit der entsprechenden Kalenderwoche steht. Ist dies nicht der Fall funktioniert der Filter nicht und es werden auch andere Zeilen mit falscher Kalenderwoche kopiert.
Kann mir jemand bei dem Problem helfen?
Liebe Grüße

Sub Filtern_Kopieren()
' Filtern_Kopieren
ThisWorkbook.Worksheets("Allgemein").Activate
ActiveSheet.Range("B13:L69").AutoFilter
ActiveSheet.Range("B13:L69").AutoFilter Field:=6, Criteria1:=Sheets("Aktuell").Range("K5"). _
Value
ThisWorkbook.Worksheets("Aktuell").Range("B13:L200").ClearContents
ActiveSheet.Range("B13:L69").Copy Destination:=ThisWorkbook.Worksheets("Aktuell").Range("B13")
With Worksheets("Allgemein")
If .AutoFilterMode And .FilterMode Then .ShowAllData
End With
ThisWorkbook.Worksheets("Kombi").Activate
ActiveSheet.Range("B13:L69").AutoFilter
ActiveSheet.Range("B13:L69").AutoFilter Field:=6, Criteria1:=Sheets("Aktuell").Range("K5"). _
Value
ActiveSheet.Range("B14:L69").Copy
Sheets("Aktuell").Cells(Rows.Count, 2).End(xlUp).Offset(2, 0).PasteSpecial xlPasteValues
'Kopiermodus beenden
Application.CutCopyMode = False
With Worksheets("Kombi")
If .AutoFilterMode And .FilterMode Then .ShowAllData
End With
ThisWorkbook.Worksheets("Aktuell").Activate
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeile kopieren, wenn Bedingung erfüllt
14.11.2019 09:06:31
Werner
Hallo Jessica,
du schreibst "aus allen Tabellenblättern"
gibt es noch mehr als die zwei aus deinem Code?
Wenn ja, wie heißen die Blätter, bei denen nicht gefiltert und kopiert werden soll?
Weitere Frage:
Haben deine Daten in den einzelnen Blättern Überschriften? Sollen die Überschriften beim Filtern / Kopieren auch mitkopiert werden oder nicht?
Gruß Werner
AW: Zeile kopieren, wenn Bedingung erfüllt
14.11.2019 09:30:34
Jessica
Hallo Werner
danke für deine Antwort.
Ja es gibt noch mehr Tabellenblätter, aber es soll aus allen Blättern gefiltert werden, außer aus dem "Aktuell", in welches kopiert werden soll. Die Blätter sind auch alle identisch aufgebaut. Dementsprechend habe ich nicht den ganzen Code kopiert.
Die Überschriften sollen nicht kopiert werden, lediglich die richtigen Zeilen.
Habe ich mein Problem denn verständlich erklärt?
Liebe Grüße
Anzeige
AW: Zeile kopieren, wenn Bedingung erfüllt
14.11.2019 09:46:10
Werner
Hallo Jessica,
kopier dir deine Überschriftenzeile in dein Auswertungsblatt in Zeile 13. Die bleibt dann drin.
Sub Filtern_Kopieren()
Dim loLetzte As Long, ws As Worksheet
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Aktuell")
loLetzte = .Cells(.Rows.Count, "B").End(xlUp).Row
If loLetzte > 13 Then
.Range(.Cells(14, "B"), .Cells(loLetzte, "L")).ClearContents
End If
End With
For Each ws In ThisWorkbook.Worksheets
If ws.Name  "Aktuell" Then
With ws
.Range("B13:L69").AutoFilter
.Range("B13:L69").AutoFilter Field:=6, Criteria1:=Sheets("Aktuell") _
.Range("K5").Value
'Prüfen ob ein Filterergebnis vorhanden ist
If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible) _
.Cells.Count > 1 Then
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Copy
Sheets("Aktuell").Cells(Rows.Count, "B").End(xlUp).Offset(2) _
.PasteSpecial xlPasteValues
End With
End If
If .AutoFilterMode And .FilterMode Then .ShowAllData
End With
End If
Next ws
Application.CutCopyMode = False
End Sub
Gruß Werner
Anzeige
AW: Zeile kopieren, wenn Bedingung erfüllt
14.11.2019 10:00:22
Jessica
Hallo Werner,
leider stört er sich an dieser Zeile. Hast du eine Idee woran das liegen könnte?
Liebe Grüße
.Range("B13:L69").AutoFilter Field:=6, Criteria1:=Sheets("Aktuell") _
.Range("K5").Value
'Prüfen ob ein Filterergebnis vorhanden ist
AW: Zeile kopieren, wenn Bedingung erfüllt
14.11.2019 11:08:00
Jessica
Hallo Werner,
ich habe deinen code nochmal etwas geändert. Jetzt funktioniert es perfekt. Ein riesen großes Dankeschön an dich.
Ich wünsche dir noch einen schönen Tag
Liebe Grüße
Danke für die Rückmeldung und...
14.11.2019 14:15:33
Werner
Hallo Jessica,
...würde mich schon interessieren, was du da jetzt noch geändert hast. Poste doch mal den Code, so wie er jetzt funktioniert.
Und noch eine Anmerkung: "leider stört er sich an dieser Zeile" ist für eine Fehlerbeschreibung nicht besonders hilfreich.
Der Code war von mir getestet und hat bei mir ohne Fehler funktioniert.
Deshalb zukünftig bitte die Fehlernummer und Fehlerbeschreibung hier mitteilen.
Gruß Werner
Anzeige

404 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige