Sub Macro1()
Dim Dl1 As Long ' dernière ligne
Dim i As Long
Dim Cellule As Range
Dim Col As String
Dim AncienmodeCalcul As Variant
'sur le premier onglet de données ("retrait1"),
'tirer les formules de la ligne 2 jusqu'au nombre de lignes existant sur l'onglet "test".
'par exemple si je colle 2 000 lignes sur l'onglet "test",
'il faut que j'ai également 2 000 lignes sur l'onglet "retrait1"
With Sheets("test")
Dl1 = .Range("A" & .Rows.Count).End(xlUp).Row ' dernière ligne
End With
Select Case MsgBox("Traitement feuille retrait1", vbYesNoCancel Or vbInformation Or vbDefaultButton1, Application.Name)
Case vbYes
With Sheets("retrait1")
If .Range("A" & .Rows.Count).End(xlUp).Row > 2 Then .Rows("3:" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents
For i = 1 To 18
.Cells(2, i).AutoFill Destination:=.Range(.Cells(2, i), .Cells(Dl1, i)), Type:=xlFillDefault
Next i
End With
Case vbNo
Case vbCancel
Exit Sub
End Select
'sur le deuxième onglet de données ("retrait2"), _
tirer les formules de la ligne 2 jusqu'au nombre de lignes existant sur l'onglet "test". _
Puis éliminer les lignes quand il y a un 0 dans la colonne O (Mes paramètres produit)
Select Case MsgBox("Traitement feuille retrait2", vbYesNoCancel Or vbInformation Or vbDefaultButton1, Application.Name)
Case vbYes
With Sheets("retrait2")
If .Range("A" & .Rows.Count).End(xlUp).Row > 2 Then .Rows("3:" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents
For i = 1 To 18
.Cells(2, i).AutoFill Destination:=.Range(.Cells(2, i), .Cells(Dl1, i)), Type:=xlFillDefault
Next i
'parametre
On Error GoTo FinProcedure1
'------------------------------------------------------------
' Au début de la macro
'------------------------------------------------------------
AncienmodeCalcul = Application.Calculation
With Application
.ScreenUpdating = False 'Cette propriété a la valeur True si la mise à jour de l'écran est activée
.EnableEvents = False
.Calculation = xlManual
.DisplayAlerts = False 'interdit les messages d'avertissements
End With
Col = "0"
For i = Dl1 To 2 Step -1
If CStr(.Range("O" & i)) = "0" Then .Rows(i).Delete Shift:=xlUp
Next i
End With ' Rétablir les paramètres
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = AncienmodeCalcul
End With
FinProcedure1:
Case vbNo
Case vbCancel
Exit Sub
End Select
Select Case MsgBox("Traitement feuille retrait3", vbYesNoCancel Or vbInformation Or vbDefaultButton1, Application.Name)
Case vbYes
With Sheets("retrait3")
If .Range("A" & .Rows.Count).End(xlUp).Row > 2 Then .Rows("3:" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents
For i = 1 To 18
.Cells(2, i).AutoFill Destination:=.Range(.Cells(2, i), .Cells(Dl1, i)), Type:=xlFillDefault
Next i
'parametre
On Error GoTo FinProcedure2
'------------------------------------------------------------
' Au début de la macro
'------------------------------------------------------------
AncienmodeCalcul = Application.Calculation
With Application
.ScreenUpdating = False 'Cette propriété a la valeur True si la mise à jour de l'écran est activée
.EnableEvents = False
.Calculation = xlManual
.DisplayAlerts = False 'interdit les messages d'avertissements
End With
Col = "0"
For i = Dl1 To 2 Step -1
If CStr(.Range("O" & i)) = "0" Then .Rows(i).Delete Shift:=xlUp
Next i
End With ' Rétablir les paramètres
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = AncienmodeCalcul
End With
FinProcedure2:
Case vbNo
Case vbCancel
Exit Sub
End Select
' copie des données dans feuille retrait1
'copier une ligne
With Sheets("retrait2")
Dl1 = .Range("A" & .Rows.Count).End(xlUp).Row ' dernière ligne
.Rows("2:" & Dl1).Copy _
Destination:=Worksheets("retrait1").Range("A" & Worksheets("retrait1").Cells(Worksheets("retrait1").Rows.Count, 1).End(xlUp).Row + 1)
End With
With Sheets("retrait3")
Dl1 = .Range("A" & .Rows.Count).End(xlUp).Row ' dernière ligne
.Rows("2:" & Dl1).Copy _
Destination:=Worksheets("retrait1").Range("A" & Worksheets("retrait1").Cells(Worksheets("retrait1").Rows.Count, 1).End(xlUp).Row + 1)
End With
End Sub
Le temps d'éxéction est relativement long.
un message est affiché au terme du traitement de chaque feuille.