Compiler plusieurs onglets en un seul avec conditions

[bakubaku]

Bonjour à tous,

j'ai vu plusieurs discussions en rapport avec ma problématique, mais j'ai des conditions qui rendent le tout plus compliqué

j'aimerais combiner les données de 3 onglets sur un seul, les colonnes sont les mêmes (il y en a 18) et dans le même ordre à chaque fois, j'aimerais au final mettre les données à la suite les unes des autres

les 3 onglets sont peuplés par le biais de formules depuis un onglet "test" où je vais coller des données chaque semaine depuis un rapport externe, le volume de données peut varier selon les semaines

voici mon fichier exemple:
http://www.filedropper.com/testmaterielfixe_1

dans un monde idéal j'aimerais une macro qui puisse :

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"

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)

sur le troisième onglet de données ("retrait3"), 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)

une fois que cela est fait, c'est là qu'il faudrait mettre les données restantes de retrait2 et retrait3 à la suite de celles de retrait1, soit sur retrait1 soit sur un nouvel onglet "final"

est-ce que vous pensez que c'est possible?

merci d'avance!

 

[jp14]

Re : Compiler plusieurs onglets en un seul avec conditions

Bonsoir

Ci dessous une procédure pour faire le travail demandé.

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.

A tester

JP

 

[bakubaku]

Re : Compiler plusieurs onglets en un seul avec conditions

Bonjour JP

merci beaucoup pour la procédure qui fait parfaitement son boulot!

cependant il y a un détail que je n'avais pas mentionné dans mon "monde idéal",
c'est que les lignes restantes des onglets "retrait2" et "retrait3" devraient être copiées/collées en valeur à la suite des données de l'onglet "retrait1",
actuellement elles sont collées avec les formules actives ce qui ne fait plus afficher les bonnes données

je vais essayer de trouver le bout de code qui fait ce copier/coller, mais si vous avez la possibilité de faire la modif je vous en serais reconnaissant

merci d'avance

 

[jp14]

Re : Compiler plusieurs onglets en un seul avec conditions

Bonjour

Ci dessous le code pour copier les données.
Pour être cohérent avec le début j'ai rajouté la possibilité qe sortir de la procédure.

'copier une ligne
Select Case MsgBox("Copie des données", vbYesNoCancel Or vbInformation Or vbDefaultButton1, Application.Name)

    Case vbYes
        With Sheets("retrait2")
        Dl1 = .Range("A" & .Rows.Count).End(xlUp).Row ' dernière ligne
         
        .Rows("2:" & Dl1).Copy
        Worksheets("retrait1").Range("A" & Worksheets("retrait1").Cells(Worksheets("retrait1").Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
        End With
        With Sheets("retrait3")
        Dl1 = .Range("A" & .Rows.Count).End(xlUp).Row ' dernière ligne
         
        .Rows("2:" & Dl1).Copy
        Worksheets("retrait1").Range("A" & Worksheets("retrait1").Cells(Worksheets("retrait1").Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
        End With
    Case vbNo
    
    Case vbCancel
        Exit Sub
End Select

A tester

JP

 

[bakubaku]

Re : Compiler plusieurs onglets en un seul avec conditions

merci JP!

j'ai testé et tout marche parfaitement

merci encore pour votre aide rapide!