Office: Wenn bestimmter Wert in Spalte "P" dann Zeile kopieren

Ciao Werner,

auch, wenn schon ein paar Tage vergangen sind, wünsche ich dir und allen anderen erstmal ein Frohes neues Jahr.

Ich habe da nochmal eine Frage wegen deinem o.g. Code.
Ich würde gerne diesen Code beim schliessen der Excel-Datei durchlaufen lassen.

Bisher habe ich dies so gelöst:

PHP:

         Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Dim loLetzteQuelle As Long, loLetzte As Long
With Worksheets("Ägypten_Premier_League")
If WorksheetFunction.CountIf(.Columns(16), 1) > 0 Then
loLetzteQuelle = .Cells(.Rows.Count, 2).End(xlUp).Row
loLetzte = .Cells(.Rows.Count, 86).End(xlUp).Offset(1).Row
If loLetzte < 2 Then loLetzte = 2
.Range(.Cells(3, 2), .Cells(loLetzteQuelle, 16)).AutoFilter field:=15, Criteria1:=1
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1, _
.AutoFilter.Range.Columns.Count - 1).Copy .Cells(loLetzte, 86)
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).Columns(15) _
.SpecialCells(xlCellTypeVisible).ClearContents
If .AutoFilterMode Then .AutoFilterMode = False
End If
End With
With Worksheets("Albanien_Superliga")
If WorksheetFunction.CountIf(.Columns(16), 1) > 0 Then
loLetzteQuelle = .Cells(.Rows.Count, 2).End(xlUp).Row
loLetzte = .Cells(.Rows.Count, 86).End(xlUp).Offset(1).Row
If loLetzte < 2 Then loLetzte = 2
.Range(.Cells(3, 2), .Cells(loLetzteQuelle, 16)).AutoFilter field:=15, Criteria1:=1
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1, _
.AutoFilter.Range.Columns.Count - 1).Copy .Cells(loLetzte, 86)
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).Columns(15) _
.SpecialCells(xlCellTypeVisible).ClearContents
If .AutoFilterMode Then .AutoFilterMode = False
End If
End With
With Worksheets("Algerien_Division_1")
If WorksheetFunction.CountIf(.Columns(16), 1) > 0 Then
loLetzteQuelle = .Cells(.Rows.Count, 2).End(xlUp).Row
loLetzte = .Cells(.Rows.Count, 86).End(xlUp).Offset(1).Row
If loLetzte < 2 Then loLetzte = 2
.Range(.Cells(3, 2), .Cells(loLetzteQuelle, 16)).AutoFilter field:=15, Criteria1:=1
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1, _
.AutoFilter.Range.Columns.Count - 1).Copy .Cells(loLetzte, 86)
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).Columns(15) _
.SpecialCells(xlCellTypeVisible).ClearContents
If .AutoFilterMode Then .AutoFilterMode = False
End If
End With
With Worksheets("Argentinien_Primera_Divisiòn")
If WorksheetFunction.CountIf(.Columns(16), 1) > 0 Then
loLetzteQuelle = .Cells(.Rows.Count, 2).End(xlUp).Row
loLetzte = .Cells(.Rows.Count, 86).End(xlUp).Offset(1).Row
If loLetzte < 2 Then loLetzte = 2
.Range(.Cells(3, 2), .Cells(loLetzteQuelle, 16)).AutoFilter field:=15, Criteria1:=1
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1, _
.AutoFilter.Range.Columns.Count - 1).Copy .Cells(loLetzte, 86)
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).Columns(15) _
.SpecialCells(xlCellTypeVisible).ClearContents
If .AutoFilterMode Then .AutoFilterMode = False
End If
End With
End Sub


 

Ciao zusammen,

anscheinend ist es nicht machbar!
Werde dann jede einzelne Liga eintragen, so geht es schließlich ja auch *Smilie

Trotzdem vielen Dank an alle die sich die Mühe gemacht haben!

Gruß
Alberto