Hello,
J'ai une feuille nommée Journal du projet dans laquelle je peux ajouter des lignes via une macro toujours à la ligne 15.
Dans la colonne "A", à chaque ajout de ligne, j'incrémente contre le haut avec la formule suivante :
= INDIRECT("A"&LIGNE()+1)+1
Et la mise en forme de cellule suivante :
"J"00
Ce qui me donne
etc...
J05
J03
J02
J01
Mon but est de copier les lignes de l'ancien journal dans le nouveau.
Ma boucle fonctionne, elle s'arrête lorsque la recherche du J.. n’existe plus dans le fichier OLD
Je débute est ce quelqu'un peut vérifier le code ci-dessous qui fonctionne très bien
Merci et bonnes fêtes de fin 2017
Philippe
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52 Sub Chercher_ligne_Journal_a_copier() Dim I As Integer Dim TrouveOLD As Range Dim TrouveNEW As Range Dim PlageDeRecherche As Range Dim Valeur_ChercheeOLD As String Dim Valeur_ChercheeNEW As String Dim AdresseTrouvee As String Dim LigneTrouveeOLD As String Dim LigneTrouveeNEW As String Dim Classeur_Actif As Workbook Dim Classeur_OLD As Workbook Application.ScreenUpdating = False For I = 1 To 100 Set Classeur_Actif = ActiveWorkbook Set Classeur_OLD = Workbooks("old.xlsm") 'Chercher la ligne dans le journal du classeur OLD Windows("old.xlsm").Activate Sheets("Journal du projet").Select Valeur_ChercheeOLD = "J" & Format(1 + I, "00") 'Mise en forme du numéro pour additionner la variable afin de trouver J1 ... J10 Set PlageDeRecherche = ActiveSheet.Columns(1) 'Recherche dans la prmière colonne Set TrouveOLD = PlageDeRecherche.Cells.Find(what:=Valeur_ChercheeOLD, LookAt:=xlWhole) '(LookIn:=xlValues) 'Chercher la ligne dans le journal du classeur NEW Classeur_Actif.Activate Sheets("Journal du projet").Select Valeur_ChercheeNEW = Valeur_ChercheeOLD 'Recherche la même valeur que dans le fichier OLD Set PlageDeRecherche = ActiveSheet.Columns(1) 'Recherche dans la prmière colonne Set TrouveNEW = PlageDeRecherche.Cells.Find(what:=Valeur_ChercheeNEW, LookAt:=xlWhole) '(LookIn:=xlValues) 'Si la macro ne trouve pas la Valeur_Cherchee dans le classeur OLD elle stop la boucle If TrouveOLD Is Nothing Then MsgBox "Les données ont été importées", vbOKOnly + vbInformation, "Info" Exit For 'Arrête la boucle For I = 1 To 100 si toutes les lignes sont présentes dans les 2 fichiers Else 'Si la macro ne trouve pas la Valeur_Cherchee dans le nouveau fichier et lance la copie If TrouveNEW Is Nothing Then LigneTrouveeOLD = TrouveOLD.Row Classeur_Actif.Activate Sheets("Journal du projet").Select Insérer_une_ligne_Journal.InsérerLigneJournal Classeur_Actif.Sheets("Journal du projet").Range("B15:R15").Value = Classeur_OLD.Sheets("Journal du projet").Range("B" & LigneTrouveeOLD & ":" & "R" & LigneTrouveeOLD).Value Classeur_Actif.Activate End If End If Next 'Pour remonter à FOR le début de la boucle Classeur_Actif.Activate 'vidage des variables Set PlageDeRecherche = Nothing Set TrouveOLD = Nothing Set TrouveNEW = Nothing Application.ScreenUpdating = True 'Range("A1").Activate End Sub
Partager