1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
| Sub FilterAndCopy()
Dim Dat, DstSheet, rng, lastRow, N
Application.ScreenUpdating = False
Set DstSheet = Sheets("BQAMB CREDITMUTUEL")
DstSheet.Range("D2:L" & DstSheet.Rows.Count).ClearContents
For Each wPage In Array("ECRITURES p1", "ECRITURES p2") ' liste de page à traiter
Set Dat = Sheets(wPage)
lastRow = Dat.Cells(Dat.Rows.Count, 1).End(xlUp).Row
Set rng = Dat.Range("A2:I" & lastRow)
Set N = DstSheet.Cells(DstSheet.Rows.Count, 4).End(xlUp) ' dernier cellue vide CREDITMUTUEL colonne D
rng.AutoFilter Field:=1, _
Criteria1:="<>0"
rng.SpecialCells(xlCellTypeVisible).Copy
N.Offset(1, 0).PasteSpecial Paste:=xlPasteValues
rng.AutoFilter
Next
Application.ScreenUpdating = True
End Sub |
Partager