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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
| Sub Modifmercatog()
Dim wbS As Workbook, wbModif As Workbook
Dim shS As Worksheet, shM As Worksheet, shD As Worksheet
Dim RModVal As String, N_Client As String, FichModif As String
Dim RMod As Range, Rdp1 As String, Plag As Range, Rnp As Range
Dim np As Integer, x As Integer, compt As Integer, lA As Integer
Dim Rcas1 As Range, Rcas2 As Range, Rcas3 As Range
Dim cas1 As String, cas2 As String, cas3 As integer
Set wbS = Workbooks.Open("Z:\Gestion entreprise\VBA\Atest\CC2011T.xlsx")
Set shS = wbS.Worksheets("Pilote1")
shS.Activate
On Error Resume Next
Set RMod = Application.InputBox("Sélectionnez une plage !", "Sélection de cellules", Type:=8)
On Error GoTo 0
If Not RMod Is Nothing Then
RMod.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
RModVal = RMod(1, 1).Value
N_Client = shS.Cells(RMod.Row, 8).Value
FichModif = RModVal & " " & N_Client & ".xls"
'Ici fonction qui permet de vérifier si FichModif est ouvert dans la même instance Excel
If Existe(FichModif) Then
Set wbModif = Workbooks(FichModif)
Set shM = wbModif.Worksheets("Devis")
Set shD = ThisWorkbook.Worksheets("Devis")
'---------------------------compter le nombre de ligne entre A23 et A(Pied de page)
Set Plag = shM.Range("A24:A500")
For Each Rnp In Plag
If Rnp.Value = "Pieddepage" Then
np = Rnp.Row
x = np - 23
End If
Next
'------------------------------------insérer les lignes dans shD
If x > 33 Then
For compt = 1 To x - 33
shD.Protect userinterfaceonly:=True
shD.Activate
shD.Range(Cells(24, 1), Cells(24, 14)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("U22:AH22").Copy shD.Cells(24, 1)
Next
End If
'-----------Copier entre la ligne 23 et la ligne np les cellules colonne A de shM
shM.Activate
shM.Range(Cells(24, 1), Cells(np - 1, 1)).Copy shD.Range("A24")
'---------- Appeler les macros en fonctions des valeurs colonne A de shD
shD.Activate
'On balaye la colonne A de shD
For lA = 24 To np - 1
'Valeur des différents cas à chercher
cas1 = "Blanc"
cas2 = "xxxx0"
cas3 = 0
'Cherche la valeur dans la feuille P2, en colonne B
Set Rcas1 = shD.Columns(1).Find(What:=cas1, LookAt:=xlPart)
Set Rcas2 = shD.Columns(1).Find(What:=cas2, LookAt:=xlPart)
Set Rcas3 = shD.Columns(1).Find(What:=cas3, LookAt:=xlPart)
'Action à effectuer selon valeur
If Not Rcas1 Is Nothing Then
Range("U21:AG21").Copy Cells(lA, 1)
If Not Rcas2 Is Nothing Then
Range("U24:AG24").Copy Cells(lA, 1)
If Not Rcas3 Is Nothing Then
Range("U20:AG20").Copy Cells(lA, 1)
End If
Next lA
'-----------Copier entre la ligne 23 et la ligne np la plage de cellules colonne C à G
' copier shM dans la nouvelle sauvegarde, et dans le cas d'une modification de devis copier en rouge l'adresse
' de shM dans les classeurs d'archivage pour que les doublons soit supprimés par la suite.
Set wbModif = Nothing
Set shM = Nothing
Set shD = Nothing
End If
End If
Set RMod = Nothing
Set shS = Nothing
wbS.Close False
Set wbS = Nothing
End Sub
Private Function Existe(ByVal Fich As String) As Boolean
Dim Wb As Workbook
For Each Wb In Application.Workbooks
If Wb.Name = Fich Then
Existe = True
Exit For
End If
Next Wb
End Function |
Next sans For
Répondre avec citation
Partager