VBA-boucle: copier datas entre fichiers (1 WBKmaster/+ WBKfeeders) si WKS.Name sont =

[zebanx]

Bonjour,

Suite à l'aide bien utile de Pierre-Jean (merci!!) concernant des copies automatiques entre fichiers ouverts sur une feuille ayant le même nom ("annee"), je cherche à rendre cette donnée de "nom" de wks variable pour la copie de données entre des fichiers ouverts (d'un même répertoire pour information.).

Les données actualisées sont récupérées dans un fichier MASTER.
Elles doivent ensuite faire l'objet d'une copie partielle, pour chaque WKS du master vers un WBK d'affectation (=feeder) qui sera dans le même répertoire.

- Pour la correspondance, le nom de la WKS est identique entre le fichier MASTER et chacun des fichiers FEEDER (ie : cible + numéro WBK).
- Les noms des Workbooks des FEEDER ne comportent pas spécialement le même nombre de caractères
- Seules les 3 premières colonnes doivent être recopiées en VALEUR (ou FORMULE) et sur le range "A10" pour chaque WKS du feeder.

J'ai commencé deux codes ("boucle 1 et boucle 2") mais ils ne fonctionnent pas.

Pourriez-vous m'apporter vos lumières sur les corrections à apporter ?

Vous en remerciant, cdlt
thierry

Ci-joint les deux fichiers et le code de la boucle 2

Sub Boucle2()
Dim CT As Workbook
Dim OT As Worksheet
Dim DEST As Range
Dim C As Workbook
Dim O As Worksheet
Dim Cstart As Workbook
Dim i As Integer

On Error Resume Next
Set CT = Workbooks("wks_master.xls") 'définit le classeur de travail CT
Set OT = CT.Sheets(i) 'définit l'onglet de travail OT
Set Cstart = Workbooks("start.xls")
On Error GoTo 0

Application.ScreenUpdating = False
If Not Cstart Is Nothing Then Cstart.Close False

For Each C In Application.Workbooks 'boucle 1 : sur tous les classeurs ouverts
If Not C.Name = CT.Name Then 'condition : si le classeur n'est pas CT
On Error Resume Next
OT.Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Copy Destination:=C.Sheets(i).Range("A10")
On Error GoTo 0
C.Save
C.Close
End If 'fin de la condition 1
Next C 'prochain classeur de la boucle 1
'Fin:
Range("B1").Select
End Sub

 

[pierrejean]

Re

dans ta boucle2 i n'a pas de valeur !!!

 

[zebanx]

Bonjour Pierre-Jean,

Merci pour ce premier retour. Effectivement... désolé.

J'ai modifié le code en intégrant une variable j pour le passage d'un onglet à l'autre dans le WKB_master et modifié le code mais...s ça ne fonctionne pas non plus.
Difficile de s'y retrouver dans le code entre ce qui serait du compteur numérique et un besoin de faire une correspondance "string" sur le nom des onglets..

Je vous en remercie par avance si vous pouvez m'aiguiller sur des modifications à tester.
Cdlt
-----
Sub Boucle2()
Dim CT As Workbook
Dim OT As Worksheet
Dim DEST As Range
Dim CF As Workbook
Dim OF As Worksheet
Dim Cstart As Workbook
Dim i As Variant
Dim j As Variant

On Error Resume Next
Set CT = Workbooks("wks_master.xls") 'définit le classeur de travail CT
Set OT = CT.Sheets(i) 'définit l'onglet de travail OT
Set OF = CF.Sheets(j)
Set Cstart = Workbooks("start.xls")
On Error GoTo 0

Application.ScreenUpdating = False
If Not Cstart Is Nothing Then Cstart.Close False

On Error GoTo Fin
For Each CF In Application.Workbooks 'boucle 1 : sur tous les classeurs ouverts
If Not CF.Name = CT.Name Then 'condition : si le classeur n'est pas CT
On Error Resume Next
'For i = 1 To Worksheets.Count
For j = 1 To Worksheets.Count
If OT.Name = OF.Name Then
OT.Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Copy Destination:=CF.Sheets(j).Range("A10")
Else
End If
Sheets (j).Select
Next j
'Next i
On Error GoTo 0
CF.Save
CF.Close
End If 'fin de la condition 1
Next CF 'prochain classeur de la boucle 1
Fin:
Range("B1").Select
End Sub

 

[zebanx]

Bonsoir Pierre-Jean.

Après de nombreuses heures, et en figeant la 4ième Wks de chaque feeder, ce code semble fonctionner.

J'ai fait beaucoup de demandes depuis 2/3 jours et vous avez souvent répondu à mes sollicitations et je tenais à vous remercier parce que vos remarques sont précieuses.

Bonne soirée.
thierry

-------
Ci-joint le code qui sera je l'espère utile à d'autres participants qui ont besoin de faire du déversement automatique régulièrement.

Sub Boucle()
Dim CT As Workbook
Dim OT As Worksheet
Dim DEST As Range
Dim CF As Workbook
Dim OF As Worksheet
Dim Cstart As Workbook
Dim i As Variant
Dim j As Integer
Dim K As Integer

On Error Resume Next
Set CT = Workbooks("master.xls")
Set OT = CT.Sheets(i)
Set OF = CF.Sheets(j)
Set Cstart = Workbooks("start.xls")
j = 4
K = 1
On Error GoTo 0

Application.ScreenUpdating = False
If Not Cstart Is Nothing Then Cstart.Close False

For Each CF In Application.Workbooks 'boucle 1 : sur tous les classeurs ouverts
If Not CF.Name = CT.Name Then 'condition : si le classeur n'est pas CT
On Error Resume Next
Workbooks("master.xls").Sheets(K).Select
For i = 1 To Worksheets.Count
If CT.Sheets(i).Name = CF.Sheets(4).Name Then
CT.Sheets(i).Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Copy Destination:=CF.Sheets(4).Range("A10")
Range("A1").Select
Else
End If
Sheets(i).Select
Next i
On Error GoTo 0
CF.Save
CF.Close
End If 'fin de la condition 1

Next CF 'prochain classeur de la boucle 1
Sheets(1).Select
Range("A1").Select
End Sub