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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
| Option Explicit
Sub Extraction()
Dim PL1 As Worksheet
Dim PLF As Worksheet
Dim P1 As Range
Dim Pf As Range
Dim NvlleLigne As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Dcl1 As Integer
Dim Dlg1 As Integer
Dim Dlg2 As Integer
Dim Item As Range
Set PL1 = ThisWorkbook.Sheets("Planning1")
Set PLF = ThisWorkbook.Sheets("Planning final")
Set P1 = PL1.Range("A6")
Set Pf = PLF.Range("A6")
Set NvlleLigne = PLF.Range("A1")
P1 = P1.Offset(0)
Pf = Pf.Offset(0)
NvlleLigne = NvlleLigne.Offset(0)
Application.ScreenUpdating = False 'Bloque le rafraichissement de l'écran
With Sheets("Planning1")
Dcl1 = .Cells(2, .Columns.Count).End(xlToLeft).Column ' On compte le nombre de colonne de l'onglet Planning1
End With
With Sheets("Planning final")
Dlg1 = .Cells(.Rows.Count, 1).End(xlUp).Row ' On compte le nombre de ligne de la feuille Planning final
End With
With Sheets("Planning1")
Dlg2 = .Cells(.Rows.Count, 1).End(xlUp).Row ' On compte le nombre de ligne de la feuille Planning1
End With
PLF.Range("D6:J" & Dlg1).ClearContents ' Ici on effece les données de la feuille Planning final ( en supposant que le nombre de colonne sera toujours le même)
PLF.Range("D6:J" & Dlg1).Interior.ColorIndex = 15 ' On colorie en gris
For i = 0 To Dlg2 ' cette boucle va ajouter de nouvelles ligne sur la feuille planning final si elles n'existent pas
Set Item = PLF.Columns(1).Find(P1.Offset(i, 0), LookIn:=xlValues, LookAt:=xlWhole)
If Item Is Nothing Then
PLF.Range("A" & Dlg1 & ":" & "J" & Dlg1).Copy
NvlleLigne.Offset(Dlg1, 0).PasteSpecial
NvlleLigne.Offset(Dlg1, 0) = P1.Offset(i, 0)
NvlleLigne.Offset(Dlg1, 1) = P1.Offset(i, 1)
PLF.Range("D" & Dlg1 + 1 & ":" & "J" & Dlg1 + 1).Interior.ColorIndex = 4 ' on colorie la nouvelle ligne
Dlg1 = Dlg1 + 1
Application.CutCopyMode = False ' arrête la surbrillance de la ligne copiée
End If
Next i
i = 0
Do While Pf.Offset(j, 0) <> "" ' Cette boucle va fonctionner tant que la colonne A de l'onglet Planning Final n'est pas vide
If P1.Offset(i, 0) = Pf.Offset(j, 0) And P1.Offset(i, 1) = Pf.Offset(j, 1) Then 'Ici on selectionne les valeurs de Planning 1 qui sont égale à celle de Plannig final
k = j ' quand les valeurs sont égale on met en mémoire le numéro de ligne de l'onglet Planning Final
For j = 3 To Dcl1 + 1 'Ici on va boucler sur toute les cellules de la ligne
If P1.Offset(i, j) <> "" Then
Pf.Offset(k, j) = P1.Offset(i, j)
If PLF.Range("D" & k + 6 & ":" & "J" & k + 6).Interior.ColorIndex <> 4 Then 'Ici on impose k+6 car la référence de Pf est A6
PLF.Range("D" & k + 6 & ":" & "J" & k + 6).Interior.ColorIndex = 28 ' on colorie les lignes où il y a des données sauf is il s'agit d'un nouvel équipement.
End If
End If
Next j
i = i + 1 ' si on a trouvé des valeurs égales on passe à la ligne suivante de la feuille Planning1
j = 0
Else
i = i ' Si on n'as pas de valeurs identiques on reste sur la meme ligne de la feuille Planning1 et on passe à la ligne suivante de l'onglet Planning Final
j = j + 1
End If
Loop
Application.ScreenUpdating = True ' autorise le rafraichissement de l'écran
End Sub |
Find et copiage de ligne complète
Répondre avec citation
et
, le code avec ajout d'une nouvelle ligne sur le Planning final si elle n'y est pas encore (cas d'un nouvel équipement).
), j'ai corrigé quelques erreurs dans la déclaration des variables et dans le code. 
, il faut qu'ils soient absolument identiques, à l'espace près.
Partager