Bestimmte Zeilen in andere Tabellenblatt kopieren- VBA
By Timotee op dinsdag 04 januari 2022
Geplaatst in Excel
Antwoorden 1
sympathieën 0
keer bekeken 5.1K
Stemmen 0
Liefdesgemeenschap

Ik heb de volgende verhalen en kan meer tutorials volgen. Doch leider klappt es onderdompelen nicht.
Ik heb 3 tabellenblätter en möchte eine ganze Zeile in een nieuwe tabellenblatt (WEKELIJKSE BESPREKING) gekopieerd, wenn eine bestimmte Bedingung (Criteria) erfüllt is.

Nun ich mit Macros gearbeitet and followden Code erstellt.
Zunächst wurde nur die Information aus onem Tabellenblatt angezeigt, obwohl mein Code all 3 Tabellenblätter anzeigt. Als u denkt dat het mogelijk is dat de informatie niet wordt ondergedompeld als A1 bezeichnen, kunnen we de informatie onderdompelen in informatie. Dus hab ich "CopyToRange" in de code beschreven. Het is mogelijk dat er geen updates plaatsvinden en dat er meerdere meldingen zijn.

Was ist een meinem Code vals?
Wie bekomme ich bestimmte Zeilen aus mehreren Tablelenblättern in one neue Übersichtstabelle? Alle tabellen worden weergegeven in een Excel-bestand (macro-enabled template).

Als het zo zou zijn, zou je het kunnen helpen.
Herzlichen Dank im Vorfeld.
Timotee





Subfilter_TeamUpdate()
'
' Filter_TeamUpdate-macro
'Timotee
'
lngLastRowANNA = Bladen("ANNA").Cells(Rijen.Aantal, 1).End(x1Up).Rij
lngLastRowJULIA = Bladen("JULIA").Cells(Rijen.Aantal, 1).End(x1Up).Rij
lngLastRowANDREA = Bladen("ANDREA").Cells(Rijen.Aantal, 1).End(x1Up).Rij
lngLastRow = ActiveSheet.UsedRage.Row(ActiveSheet.UsedRage.Rows.Count).Rij


Bladen("WEKELIJKSE DISCUSSIE").Selecteer

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

lngLastRow = Sheets("WEKELIJKSE DISCUSSIE").Cells(Rijen.Aantal, 1).End(x1Up).Rij

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

lngLastRow = Sheets("WEKELIJKSE DISCUSSIE").Cells(Rijen.Aantal, 1).End(x1Up).Rij

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

lngLastRow = Sheets("WEKELIJKSE DISCUSSIE").Cells(Rijen.Aantal, 1).End(x1Up).Rij


End Sub
 
Hallo Timotee,

We hebben de code doorgenomen en enkele fouten in de broncode verholpen, kijk alsjeblieft:

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


Ik hoop dat dit voor je werkt.

Amanda
Amanda Lee
·
2 jaar geleden
·
0 Likes
·
0 Stemmen
·
0 reacties
·
Bekijk het volledige bericht