Items des Array à remplacer par une liste

Le
Alain Lebayle
Bonjour,
Isabelle m'a fournit une procédure qui fonctionne à merveille
Mais est-il possible de remplacer :

LesNoms = Array("BRAVO", "CHARLY", etc.) par une liste sur une feuille
de calcul que j'appelle lesvilles ?
Je vous remercie
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
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
Daniel.C
Le #21258311
Re.
Essaie :

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 = 1 To Range("lesvilles").Count
x = Range("lesvilles")(i)
For Each C In Range("B16:B200").Cells

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

With Workbooks("2010-" & Range("lesvilles")(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

Daniel

Bonjour,
Isabelle m'a fournit une procédure qui fonctionne à merveille
Mais est-il possible de remplacer :

LesNoms = Array("BRAVO", "CHARLY", etc.) par une liste sur une feuille de
calcul que j'appelle lesvilles ?
Je vous remercie
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


Alain Lebayle
Le #21261331
Bonsoir Daniel,
En fait, j'ai mal dû m'expliquer, je souhaite pouvoir remplacer les
noms, BRAVO, CHARLY, ETC. par des noms que je saisi dans une feuille de
calcul que j'appelle lesvilles, ceci afin d'éviter de saisir dans le
code VBA.
Je te remercie
Alain


Daniel.C a écrit :
Re.
Essaie :

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 = 1 To Range("lesvilles").Count
x = Range("lesvilles")(i)
For Each C In Range("B16:B200").Cells

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

With Workbooks("2010-" & Range("lesvilles")(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

Daniel

Bonjour,
Isabelle m'a fournit une procédure qui fonctionne à merveille
Mais est-il possible de remplacer :

LesNoms = Array("BRAVO", "CHARLY", etc.) par une liste sur une feuille
de calcul que j'appelle lesvilles ?
Je vous remercie
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






Daniel.C
Le #21261511
Bonsoir.

J'ai pris comme plage les cellules A1:An de la feuille "lesvilles" :

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)
Set sh = Sheets("lesvilles")
For i = 1 To sh.[A65000].Rows.Count
x = sh.Range("A1").Offset(i - 1)
For Each C In Range("B16:B200").Cells

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

With Workbooks("2010-" & sh.Range("A1").Offset(i - _
1) & ".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

Daniel

Bonsoir Daniel,
En fait, j'ai mal dû m'expliquer, je souhaite pouvoir remplacer les noms,
BRAVO, CHARLY, ETC. par des noms que je saisi dans une feuille de calcul que
j'appelle lesvilles, ceci afin d'éviter de saisir dans le code VBA.
Je te remercie
Alain


Daniel.C a écrit :
Re.
Essaie :

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 = 1 To Range("lesvilles").Count
x = Range("lesvilles")(i)
For Each C In Range("B16:B200").Cells

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

With Workbooks("2010-" & Range("lesvilles")(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

Daniel

Bonjour,
Isabelle m'a fournit une procédure qui fonctionne à merveille
Mais est-il possible de remplacer :

LesNoms = Array("BRAVO", "CHARLY", etc.) par une liste sur une feuille de
calcul que j'appelle lesvilles ?
Je vous remercie
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








Alain Lebayle
Le #21261991
Re bonsoir,
C'est absolument cela maintenant !!!
C'est parfait !
Un très grand merci !
Bonne soirée
Alain

Daniel.C a écrit :
Bonsoir.

J'ai pris comme plage les cellules A1:An de la feuille "lesvilles" :

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)
Set sh = Sheets("lesvilles")
For i = 1 To sh.[A65000].Rows.Count
x = sh.Range("A1").Offset(i - 1)
For Each C In Range("B16:B200").Cells

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

With Workbooks("2010-" & sh.Range("A1").Offset(i - _
1) & ".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

Daniel

Bonsoir Daniel,
En fait, j'ai mal dû m'expliquer, je souhaite pouvoir remplacer les
noms, BRAVO, CHARLY, ETC. par des noms que je saisi dans une feuille
de calcul que j'appelle lesvilles, ceci afin d'éviter de saisir dans
le code VBA.
Je te remercie
Alain


Daniel.C a écrit :
Re.
Essaie :

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 = 1 To Range("lesvilles").Count
x = Range("lesvilles")(i)
For Each C In Range("B16:B200").Cells

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

With Workbooks("2010-" & Range("lesvilles")(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

Daniel

Bonjour,
Isabelle m'a fournit une procédure qui fonctionne à merveille
Mais est-il possible de remplacer :

LesNoms = Array("BRAVO", "CHARLY", etc.) par une liste sur une
feuille de calcul que j'appelle lesvilles ?
Je vous remercie
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












Publicité
Poster une réponse
Anonyme