Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Boucle afin de simplifier ma procédure

2 réponses
Avatar
Alain Lebayle
Bonsoir,

Grâce notamment à Michdenis, j'ai réalisé un programme qui fonctionne
très bien, mais je pense que l'on peut simplifier celle-ci.

Je vous remercie
Alain

Sub Test_C5()

Application.ScreenUpdating = False

Dim Chemin As String, Fichier As String
Dim Wk As Workbook

Chemin = "C:\C5 ALPHA\"

Fichier = Dir(Chemin & "C5*.xls")

If Fichier = "" Then
MsgBox "Aucun fichier débutant par ""C5"" n'a été trouvé.", _
vbExclamation, " Abscence du fichier !"
Exit Sub
Else
Set Wk = Workbooks.Open(Chemin & Fichier)
End If

'*************************
With Wk

'Le code

Mavar = Range("I11").Value
Mavar1 = Right(Mavar, 10)

Dim C As Range
For Each C In Range("B16:B200").Cells
'-------------------------
'BRAVO

If C.Value = "BRAVO" Then
Mavar2 = C.Offset(0, 15)

ChDir "C:\C5 ALPHA"
Workbooks.Open Filename:="C:\C5 ALPHA\2010-BRAVO.xls"

With Workbooks("2010-BRAVO.xls")
Dim MaDate As Date, D As Range
MaDate = Mavar1

For Each D In Range("A9:A300")
If D.Value = MaDate Then
D.Offset(0, 1) = Mavar2

End If
Next

.Save
.Close

End With

End If
Next
End With


'*************************
With Wk

'Le code

Mavar = Range("I11").Value
Mavar1 = Right(Mavar, 10)

For Each C In Range("B16:B200").Cells

'-------------------------
'CHARLY

If C.Value = "CHARLY" Then
Mavar2 = C.Offset(0, 15)

ChDir "C:\C5 ALPHA"
Workbooks.Open Filename:="C:\C5 ALPHA\2010-CHARLY.xls"

With Workbooks("2010-CHARLY.xls")
MaDate = Mavar1

For Each D In Range("A9:A300")
If D.Value = MaDate Then
D.Offset(0, 1) = Mavar2

End If
Next

.Save
.Close

End With

End If
Next
End With

ETC...

2 réponses

Avatar
isabelle
bonjour Alain,

Sub Test_C5()
Application.ScreenUpdating = False
Dim Chemin As String, Fichier As String
Dim Wk As Workbook
Dim MaDate As Date, D As Range
Dim C As Range

Chemin = "C:C5 ALPHA"
Fichier = Dir(Chemin & "C5*.xls")

If Fichier = "" Then
MsgBox "Aucun fichier débutant par ""C5"" n'a été trouvé.", _
vbExclamation, " Abscence du fichier !"
Exit Sub
Else
Set Wk = Workbooks.Open(Chemin & Fichier)
End If

LesNoms = Array("BRAVO", "CHARLY")

With Wk
Mavar = Range("I11").Value
Mavar1 = Right(Mavar, 10)

For i = LBound(LesNoms) To UBound(LesNoms)
x = LesNoms(i)
For Each C In Range("B16:B200").Cells

If C.Value = LesNoms(i) Then
Mavar2 = C.Offset(0, 15)
ChDir "C:C5 ALPHA"
Workbooks.Open Filename:="C:C5 ALPHA2010-" & LesNoms(i) & ".xls"

With Workbooks("2010-" & LesNoms(i) & ".xls")
MaDate = Mavar1

For Each D In Range("A9:A300")
If D.Value = MaDate Then
D.Offset(0, 1) = Mavar2
End If
Next
.Save
.Close
End With
End If
Next
Next
End With
End Sub

isabelle

Le 2010-02-22 13:53, Alain Lebayle a écrit :
Sub Test_C5()

Application.ScreenUpdating = False

Dim Chemin As String, Fichier As String
Dim Wk As Workbook

Chemin = "C:C5 ALPHA"

Fichier = Dir(Chemin & "C5*.xls")

If Fichier = "" Then
MsgBox "Aucun fichier débutant par ""C5"" n'a été trouvé.", _
vbExclamation, " Abscence du fichier !"
Exit Sub
Else
Set Wk = Workbooks.Open(Chemin & Fichier)
End If

'*************************
With Wk

'Le code

Mavar = Range("I11").Value
Mavar1 = Right(Mavar, 10)

Dim C As Range
For Each C In Range("B16:B200").Cells
'-------------------------
'BRAVO

If C.Value = "BRAVO" Then
Mavar2 = C.Offset(0, 15)

ChDir "C:C5 ALPHA"
Workbooks.Open Filename:="C:C5 ALPHA2010-BRAVO.xls"

With Workbooks("2010-BRAVO.xls")
Dim MaDate As Date, D As Range
MaDate = Mavar1

For Each D In Range("A9:A300")
If D.Value = MaDate Then
D.Offset(0, 1) = Mavar2

End If
Next

.Save
.Close

End With

End If
Next
End With


'*************************
With Wk

'Le code

Mavar = Range("I11").Value
Mavar1 = Right(Mavar, 10)

For Each C In Range("B16:B200").Cells

'-------------------------
'CHARLY

If C.Value = "CHARLY" Then
Mavar2 = C.Offset(0, 15)

ChDir "C:C5 ALPHA"
Workbooks.Open Filename:="C:C5 ALPHA2010-CHARLY.xls"

With Workbooks("2010-CHARLY.xls")
MaDate = Mavar1

For Each D In Range("A9:A300")
If D.Value = MaDate Then
D.Offset(0, 1) = Mavar2

End If
Next

.Save
.Close

End With

End If
Next
End With

ETC...


Avatar
Alain Lebayle
Bonsoir Isabelle,
C'est exactement cela, c'est parfait, vraiment impressionnant !
Un très grand merci !!!
Très bonne soirée
Alain

isabelle a écrit :
bonjour Alain,

Sub Test_C5()
Application.ScreenUpdating = False
Dim Chemin As String, Fichier As String
Dim Wk As Workbook
Dim MaDate As Date, D As Range
Dim C As Range

Chemin = "C:C5 ALPHA"
Fichier = Dir(Chemin & "C5*.xls")

If Fichier = "" Then
MsgBox "Aucun fichier débutant par ""C5"" n'a été trouvé.", _
vbExclamation, " Abscence du fichier !"
Exit Sub
Else
Set Wk = Workbooks.Open(Chemin & Fichier)
End If

LesNoms = Array("BRAVO", "CHARLY")

With Wk
Mavar = Range("I11").Value
Mavar1 = Right(Mavar, 10)

For i = LBound(LesNoms) To UBound(LesNoms)
x = LesNoms(i)
For Each C In Range("B16:B200").Cells

If C.Value = LesNoms(i) Then
Mavar2 = C.Offset(0, 15)
ChDir "C:C5 ALPHA"
Workbooks.Open Filename:="C:C5 ALPHA2010-" & LesNoms(i) & ".xls"

With Workbooks("2010-" & LesNoms(i) & ".xls")
MaDate = Mavar1

For Each D In Range("A9:A300")
If D.Value = MaDate Then
D.Offset(0, 1) = Mavar2
End If
Next
.Save
.Close
End With
End If
Next
Next
End With
End Sub

isabelle

Le 2010-02-22 13:53, Alain Lebayle a écrit :
Sub Test_C5()

Application.ScreenUpdating = False

Dim Chemin As String, Fichier As String
Dim Wk As Workbook

Chemin = "C:C5 ALPHA"

Fichier = Dir(Chemin & "C5*.xls")

If Fichier = "" Then
MsgBox "Aucun fichier débutant par ""C5"" n'a été trouvé.", _
vbExclamation, " Abscence du fichier !"
Exit Sub
Else
Set Wk = Workbooks.Open(Chemin & Fichier)
End If

'*************************
With Wk

'Le code

Mavar = Range("I11").Value
Mavar1 = Right(Mavar, 10)

Dim C As Range
For Each C In Range("B16:B200").Cells
'-------------------------
'BRAVO

If C.Value = "BRAVO" Then
Mavar2 = C.Offset(0, 15)

ChDir "C:C5 ALPHA"
Workbooks.Open Filename:="C:C5 ALPHA2010-BRAVO.xls"

With Workbooks("2010-BRAVO.xls")
Dim MaDate As Date, D As Range
MaDate = Mavar1

For Each D In Range("A9:A300")
If D.Value = MaDate Then
D.Offset(0, 1) = Mavar2

End If
Next

.Save
.Close

End With

End If
Next
End With


'*************************
With Wk

'Le code

Mavar = Range("I11").Value
Mavar1 = Right(Mavar, 10)

For Each C In Range("B16:B200").Cells

'-------------------------
'CHARLY

If C.Value = "CHARLY" Then
Mavar2 = C.Offset(0, 15)

ChDir "C:C5 ALPHA"
Workbooks.Open Filename:="C:C5 ALPHA2010-CHARLY.xls"

With Workbooks("2010-CHARLY.xls")
MaDate = Mavar1

For Each D In Range("A9:A300")
If D.Value = MaDate Then
D.Offset(0, 1) = Mavar2

End If
Next

.Save
.Close

End With

End If
Next
End With

ETC...