XL 2019 VBA [résolu] Boucle pour copier sur une autre page

terry08200 · 26 Août 2021

Bonjour à tous,

Je suis débutant en VBA, et je consulte le forum souvent et je vous remercie de souvent me dépanner en répondant aux autres débutant

Voici mon problème :

J'ai dans une page 1, j'ai 3 colonnes A, B et C avec quelques lignes.
dans une autre page 2 je retrouve ces 3 colonnes avec plusieurs lignes également.

Je dois avec un bouton sur la page 1 pouvoir chercher dans la page 2, les valeurs A de la page 1 et remplacer les lignes A B C de la page 2 par celles de la page 1 à partir du moment ou les valeurs de la colonne A sont identiques.

je souhaite que cela soit fait à l'aide d'une boucle qui prend en recherche toujours la valeur de la colonne A (page 1), dans colonne A (page 2). Donc ligne par ligne.

Pouvez-vous m'apporter une solution svp ?

je vous remercie encore infiniment de votre aide !!

Bien cordialement. Terry.

terry08200 · 27 Août 2021

Re à tous j'ai réglé mon problème et cela fonctionne !!!

Dim AdressePlan As Range
Dim infoTransfert As Range
Dim Numero_plan_recherche As Range
Dim y As Long

Dim Val As String, Insert As String
Dim Art As Range

celfin = Range("A1:A" & Range("A1").End(xlDown).Row).Count 'récupère le nombre de cellule non vide

For Cel = 2 To celfin 'de la cellule A2 a A dernière remplie

Worksheets("Nomenclature").Activate 'active la page des plans
Range("A" & 2).Activate
Set Numero_plan_recherche = ActiveCell.Offset(Cel, 0)
With Numero_plan_recherche
End With

Range(Numero_plan_recherche, Numero_plan_recherche.Offset(0, 11)).Copy 'copie la ligne...

terry08200 · 27 Août 2021

Bonjour,

J'ai avancé sur mon fichier EXCEL d'origine ...

Voici le code...j'ai mis en rouge mon problème actuel.
je ne sais pas comment faire pour copier ligne par ligne la valeur de la colonne A.
pour exécuter le reste du code.

Bien à vous !!

'Worksheets("Nomenclature").Activate 'active la page des plans
'Range("A2:L2").Select 'selection de la première ligne du tableau
'Range(Selection, Selection.End(xlDown)).Select 'selectionne jusqu'en bas du tableau

Dim AdressePlan As Range
Dim infoTransfert As Range
Dim Numero_plan_recherche As Range
Dim y As Long

Dim Val As String, Insert As String
Dim Art As Range

celfin = Range("A1:A" & Range("A1").End(xlDown).Row).Count 'récupère le nombre de cellule non vide

For Cel = 2 To celfin 'de la cellule A2 a A dernière remplie

Set Numero_plan_recherche = Range("A" & "2") '*****je dois prendre A ligne par ligne ....
With Numero_plan_recherche
End With

Range(Numero_plan_recherche, Numero_plan_recherche.Offset(0, 11)).Copy

Worksheets("Classeur Plans").Activate
Set AdressePlan = ActiveSheet.Cells.Find(Numero_plan_recherche, , xlValues, xlWhole) 'recherche dans la page active le resultat de l'inputbox

If AdressePlan Is Nothing Then
MsgBox "Pas de plan trouvé, recherche dans les archives", vbInformation 'si pas de donnée égale renvoi un message pour présevenir qu'il va chercher dans une autre page
Worksheets("ARCHIVES").Activate 'active la page des archives
Set AdressePlan = ActiveSheet.Cells.Find(Numero_plan_recherche, , xlValues, xlWhole) 'recherche dans la page active le resultat de l'inputbox

End If
If AdressePlan Is Nothing Then
MsgBox "Pas de plan trouvé, recherche dans les archives", vbInformation 'si pas de donnée égale renvoi un message pour présevenir qu'il va chercher dans une autre page
Worksheets("ARCHIVES2").Activate 'active la page des archives
Set AdressePlan = ActiveSheet.Cells.Find(Numero_plan_recherche, , xlValues, xlWhole) 'recherche dans la page active le resultat de l'inputbox

End If
If AdressePlan Is Nothing Then
MsgBox "Pas de plan trouvé : " & Numero_plan_recherche, vbCritical 'si pas de donnée égale renvoi un message
Worksheets("CAHIERS DES PLANS").Activate 'retourner à la page d'acceuil

ElseIf AdressePlan Then
AdressePlan.Select 'selectionne la case si trouvé
ActiveSheet.Paste 'colle la selection copier précédemment.
End If
Next Cel

terry08200 · 27 Août 2021

Re à tous j'ai réglé mon problème et cela fonctionne !!!

Dim AdressePlan As Range
Dim infoTransfert As Range
Dim Numero_plan_recherche As Range
Dim y As Long

Dim Val As String, Insert As String
Dim Art As Range

celfin = Range("A1:A" & Range("A1").End(xlDown).Row).Count 'récupère le nombre de cellule non vide

For Cel = 2 To celfin 'de la cellule A2 a A dernière remplie

Worksheets("Nomenclature").Activate 'active la page des plans
Range("A" & 2).Activate
Set Numero_plan_recherche = ActiveCell.Offset(Cel, 0)
With Numero_plan_recherche
End With

Range(Numero_plan_recherche, Numero_plan_recherche.Offset(0, 11)).Copy 'copie la ligne

Worksheets("Classeur Plans").Activate
Set AdressePlan = ActiveSheet.Cells.Find(Numero_plan_recherche, , xlValues, xlWhole) 'recherche dans la page active le resultat de l'inputbox

If AdressePlan Is Nothing Then
Worksheets("ARCHIVES").Activate 'active la page des archives
Set AdressePlan = ActiveSheet.Cells.Find(Numero_plan_recherche, , xlValues, xlWhole) 'recherche dans la page active le resultat de l'inputbox

End If
If AdressePlan Is Nothing Then
Worksheets("ARCHIVES2").Activate 'active la page des archives
Set AdressePlan = ActiveSheet.Cells.Find(Numero_plan_recherche, , xlValues, xlWhole) 'recherche dans la page active le resultat de l'inputbox

End If
If AdressePlan Is Nothing Then
Worksheets("CAHIERS DES PLANS").Activate 'retourner à la page d'acceuil

ElseIf AdressePlan Then
AdressePlan.Select 'selectionne la case si trouvé
ActiveSheet.Paste 'colle la selection copier précédemment.
End If
Next Cel

Phil69970 · 1 Septembre 2021

Bonjour @terry08200

Je doute que la macro que tu as posté ici fonctionne beaucoup et surtout qu'elle te donne le résultat attendu
Par contre si tu postes un fichier représentatif (sans données confidentielles que tu remplaces par des données anonyme, tu laisses que les prénoms et l'initiale du nom par exemple ...)
Dans ton fichier il devrait avoir tous les onglets (avec le bon nom) qui sont concernés par ce que tu veux faire (il devrait y en avoir au moins 4 onglets d’après ce que j'ai compris de ton code...("Classeur Plans", "Archives", "Archives2" et "CAHIERS DES PLANS")
Une dizaines de lignes minimum par onglets et les conditions de copie dans chaque onglets.....avec 2 ou 3 exemples de ce que tu veux une fois fini....==> donc avant/après pour avoir une vue d'ensemble sur ce que tu veux faire.
Dans ton code cela ne sert à rien car il n'y a rien entre with et end with
With Numero_plan_recherche
End With
Les "set=...." ne sont jamais déchargé
Les "activate" car tu as mis un peu de partout ne sont pas utile ici et à limiter voir à proscrire d'une manière générale en bref tout est à revoir mais sans fichier c'est plus compliqué !!!!

@Phil69970

terry08200 · 3 Septembre 2021

Phil69970 à dit:
Bonjour @terry08200

Je doute que la macro que tu as posté ici fonctionne beaucoup et surtout qu'elle te donne le résultat attendu
Par contre si tu postes un fichier représentatif (sans données confidentielles que tu remplaces par des données anonyme, tu laisses que les prénoms et l'initiale du nom par exemple ...)
Dans ton fichier il devrait avoir tous les onglets (avec le bon nom) qui sont concernés par ce que tu veux faire (il devrait y en avoir au moins 4 onglets d’après ce que j'ai compris de ton code...("Classeur Plans", "Archives", "Archives2" et "CAHIERS DES PLANS")
Une dizaines de lignes minimum par onglets et les conditions de copie dans chaque onglets.....avec 2 ou 3 exemples de ce que tu veux une fois fini....==> donc avant/après pour avoir une vue d'ensemble sur ce que tu veux faire.
Dans ton code cela ne sert à rien car il n'y a rien entre with et end with
With Numero_plan_recherche
End With
Les "set=...." ne sont jamais déchargé
Les "activate" car tu as mis un peu de partout ne sont pas utile ici et à limiter voir à proscrire d'une manière générale en bref tout est à revoir mais sans fichier c'est plus compliqué !!!!

@Phil69970

Merci j'ai modifié mon travail

VB:

Public Sub Valide_Modif()

Application.ScreenUpdating = False

Continue = MsgBox("Voulez-vous continuer ?" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Les infos du tableau vont être validées !", vbQuestion + vbYesNo + vbDefaultButton2, "Continuer ?") 'valider ou arreter
    If Continue = vbNo Then
    MsgBox "Procédure annulée", vbCritical
    Exit Sub
    End If

If Range("Q2") = "" Then 'éviter de mouliner dans le vide et faire crasher excel !!!!!!
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
ElseIf Range("Q2") = "X" Then
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
ElseIf Range("Q2") = "XX" Then
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
ElseIf Range("Q2") = "XXX" Then 'évite faire n'importe quoi et remonter les X, XX, XXX ... !!
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
End If

Dim AdressePlan As Range
Dim AdressePlanCommun As Range
Dim Numero_plan_recherche As Range

Worksheets("Nomenclature").Activate 'active la page des plans
celfin = Range("A1:A" & Range("A1").End(xlDown).Row).Count 'récupère le nombre de cellule non vide

For Cel = 1 To celfin - 1 'de la cellule A2 a A dernière remplie

    Worksheets("Nomenclature").Activate 'active la page des plans
    Range("A" & 1).Activate
    Set Numero_plan_recherche = ActiveCell.Offset(Cel, 0)

    Range(Numero_plan_recherche, Numero_plan_recherche.Offset(0, 14)).Copy 'copie la ligne

Worksheets("Classeur Plans").Activate
With Worksheets("Classeur Plans").Range("A1:A" & Range("A1").End(xlDown).Row) ' POUR CHAQUE RECHERCHE PAR PAGE, ON CHOISIS LA PLAGE COLONNE A
Set AdressePlan = .Find(Numero_plan_recherche, LookIn:=xlValues) 'pour éviter de coller dans la colonne DOSSIER quand des communs retrouve leurs parain !!


If AdressePlan Is Nothing Then


    Worksheets("ARCHIVES").Activate
    With Worksheets("ARCHIVES").Range("A1:A" & Range("A1").End(xlDown).Row)
    Set AdressePlan = .Find(Numero_plan_recherche, LookIn:=xlValues)

  
        If AdressePlan Is Nothing Then
      
            Worksheets("ARCHIVES2").Activate
            With Worksheets("ARCHIVES2").Range("A1:A" & Range("A1").End(xlDown).Row)
            Set AdressePlan = .Find(Numero_plan_recherche, LookIn:=xlValues)

          
                If AdressePlan Is Nothing Then
              
                Worksheets("Outillage Commun").Activate 'active la page des archives
                                Dim Sh As Worksheet
                            For Each Sh In ThisWorkbook.Worksheets
                                If Sh.FilterMode Then 'Si on ne voit pas toutes les données
                                    Sh.ShowAllData
                                End If
                            Next

                '**********COMME IL S'AGIT DE PLAN COMMUN ON CHERCHE PAR DESIGNATION
                ActiveSheet.Range("$A$1:$J$9").AutoFilter Field:=1, Criteria1:=Numero_plan_recherche
              
                      
                        With Worksheets("Outillage Commun").Range("D1" & Range("D1").End(xlDown).Row)
                        Set AdressePlanCommun = .Find(Numero_plan_recherche.Offset(0, 3), LookIn:=xlValues)

                            If AdressePlanCommun Is Nothing Then
                                Worksheets("Outillage Commun").ShowAllData
                            Else
                                Worksheets("Outillage Commun").Activate 'c'était pas prore au dessus et j'avais des problèmes de type ...
                                AdressePlanCommun.Offset(0, -3).Select
                                Worksheets("Nomenclature").Activate
                                Range(Numero_plan_recherche, Numero_plan_recherche.Offset(0, 14)).Copy 'copie la ligne 'JE REFAIS LA COPIE DANS LE DOUTE ... DE COLLER DU VIDE A CAUSE DES SELECT
                                Worksheets("Outillage Commun").Activate
                                ActiveSheet.Paste 'colle la selection copier précédemment.
                                Worksheets("Outillage Commun").ShowAllData
                            End If
                          
                        End With
                      
                End If
              
            End With
          
            End If
          
    End With
  
ElseIf Not AdressePlan Is Nothing Then
    AdressePlan.Select 'selectionne la case si trouvé
    ActiveSheet.Paste 'colle la selection copier précédemment
End If
End With

Next Cel

Worksheets("Nomenclature").Activate

Application.ScreenUpdating = True

End Sub

Phil69970 · 3 Septembre 2021

Re

Tout ce code peut être remplacé par

VB:

If Range("Q2") = "" Then 'éviter de mouliner dans le vide et faire crasher excel !!!!!!
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
ElseIf Range("Q2") = "X" Then
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
ElseIf Range("Q2") = "XX" Then
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
ElseIf Range("Q2") = "XXX" Then 'évite faire n'importe quoi et remonter les X, XX, XXX ... !!
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
End If

Ces 3 lignes...

VB:

If [Q2] = "" Or [Q2] = "X" Or [Q2] = "XX" Or [Q2] = "XXX" Then
    MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
    Exit Sub
End If

Ma remarque est toujours d’actualité dans la plupart des cas on peut se passer des select et des activate

Phil69970 à dit:
Les "set=...." ne sont jamais déchargé
Les "activate"

@Phil69970

XL 2019 VBA [résolu] Boucle pour copier sur une autre page

terry08200

XLDnaute Nouveau

Pièces jointes

terry08200

terry08200

XLDnaute Nouveau

terry08200

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

terry08200

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

Discussions similaires