Skip to main content
Support is Offline
Today is our off day. We are taking some rest and will come back stronger tomorrow
Official support hours
Monday To Friday
From 09:00 To 17:30
  Tuesday, 04 January 2022
  1 Replies
  4.8K Visits
0
Votes
Undo
Liebe Community

ich habe folgendes Anliegen und habe bereits mehrere Tutorials durchgeschaut. Doch leider klappt es immernoch nicht.
Ich hab 3 Tabellenblätter und möchte eine ganze Zeile in ein neues Tabellenblatt ( WEEKLY DISCUSSION) kopieren, wenn eine bestimmte Bedingung (Criteria) erfüllt ist.

Nun hab ich mit Macros gearbeitet und folgenden Code erstellt.
Zunächst wurde nur die Information aus einem Tabellenblatt angezeigt, obwohl mein Code alle 3 Tabellenblätter anzeigt. Dann habe ich gedacht, dass ich ja die letzte Zeile nicht immer als A1 bezeichnen kann, weil die Informationen immer überschreiben werden. So hab ich "CopyToRange" im Code umgeschrieben. Bei nochmaligem updaten kann dann aber eine Fehlermeldung und es wurde nichts mehr angezeigt.

Was ist an meinem Code falsch?
Wie bekomme ich bestimmte Zeilen aus mehreren Tabellenblättern in eine neue Übersichtstabelle? Alle Tabellenblätter sind in einer Excel-Datei (Macro-Enabled Template).

Ich wäre sehr froh, wenn hier jemand helfen kann.
Herzlichen Dank im Vorfeld.
Timotee





Sub Filter_TeamUpdate()
'
' Filter_TeamUpdate Macro
' Timotee
'
lngLastRowANNA = Sheets("ANNA").Cells(Rows.Count, 1).End(x1Up).Row
lngLastRowJULIA = Sheets("JULIA").Cells(Rows.Count, 1).End(x1Up).Row
lngLastRowANDREA = Sheets("ANDREA").Cells(Rows.Count, 1).End(x1Up).Row
lngLastRow = ActiveSheet.UsedRage.Row(ActiveSheet.UsedRage.Rows.Count).Row


Sheets("WEEKLY DISCUSSION").Select

Sheets("ANNA").Range("A1:H" & lngLastRowANNA).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("CRITERIAS").Range("A2:H" & lngLastRowANNA), CopyToRange:=Range("A1") _
, Unique:=False

lngLastRow = Sheets("WEEKLY DISCUSSION").Cells(Rows.Count, 1).End(x1Up).Row

Sheets("JULIA").Range("A1:H" & lngLastRowJULIA).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("CRITERIAS").Range("A2:H" & lngLastRowJULIA), CopyToRange:=Range("A" & lngLastRow + 1) _
, Unique:=False

lngLastRow = Sheets("WEEKLY DISCUSSION").Cells(Rows.Count, 1).End(x1Up).Row

Sheets("ANDREA").Range("A1:H" & lngLastRowANDREA).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("CRITERIAS").Range("A2:H" & lngLastRowANDREA), CopyToRange:=Range("A" & lngLastRow + 1) _
, Unique:=False

lngLastRow = Sheets("WEEKLY DISCUSSION").Cells(Rows.Count, 1).End(x1Up).Row


End Sub
 
2 years ago
·
#2426
0
Votes
Undo
Hi Timotee,

We've gone over the code, and fixed some errors in the source code, please have a look:

Sub Filter_TeamUpdate()
'
' Filter_TeamUpdate Macro
' Timotee
'

lngLastRowANNA = Sheets("ANNA").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowJULIA = Sheets("JULIA").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowANDREA = Sheets("ANDREA").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1

Sheets("WEEKLY DISCUSSION").Select

Sheets("ANNA").Range("A1:H" & lngLastRowANNA).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("CRITERIAS").Range("A2:H" & lngLastRowANNA), CopyToRange:=Range("A1") _
, Unique:=False

lngLastRow = Sheets("WEEKLY DISCUSSION").Cells(Rows.Count, 1).End(xlUp).Row


Sheets("JULIA").Range("A1:H" & lngLastRowJULIA).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("CRITERIAS").Range("A2:H" & lngLastRowJULIA), CopyToRange:=Range("A" & lngLastRow + 1) _
, Unique:=False

lngLastRow = Sheets("WEEKLY DISCUSSION").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("ANDREA").Range("A1:H" & lngLastRowANDREA).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("CRITERIAS").Range("A2:H" & lngLastRowANDREA), CopyToRange:=Range("A" & lngLastRow + 1) _
, Unique:=False

lngLastRow = Sheets("WEEKLY DISCUSSION").Cells(Rows.Count, 1).End(xlUp).Row


End Sub


Hope this works for you.

Amanda
  • Page :
  • 1
There are no replies made for this post yet.