Boucle afin de simplifier ma procédure

Le
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 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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
isabelle
Le #21250351
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...


Alain Lebayle
Le #21254921
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...




Publicité
Poster une réponse
Anonyme