Remplissage automatique d'un fichier excel à partir d'un autre
Bonjour la communauté,
J'espère que vous allez bien en ces temps difficiles, je me retourne vers vous car je souhaite remplir automatiquement des tableaux dans des feuilles excel fichier "cible" à l'aide d'un autre fichier "source" en effet j'ai crée un code qui me renomme les feuilles du fichier cible en fonction d'une colonne dans "source" et qui me copie le tableau d'un onglet du fichier source dans toutes les feuilles du fichiers cible mais je souhaite remplir les tableaux fichiers cible avec les données d'un onglet fichier source et je ne comprends pas ou je me suis raté sur le code, Merci de m'éclaircir en ci-joint le code :
Code:
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
| Sub Indicateurs()
Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet, Ws As Worksheet
Dim i As Long, j As Long, h As Long, k As Long, c As Long, n As Long, s As Long
Dim p As Object, m As Object
Application.ScreenUpdating = False
Windows("W12_DPIa.xlsx").Activate
Set f1 = Sheets("Tracker")
Set f2 = Sheets("Liste_des_directions")
DerLig_direction = f2.Range("A" & Rows.Count).End(xlUp).Row
DerLig_Liste = f1.Range("A" & Rows.Count).End(xlUp).Row
DerLig_projet = f2.Range("C" & Rows.Count).End(xlUp).Row
DerLig_Milestone = f1.Range("B" & Rows.Count).End(xlUp).Row
DerLg_Document = f1.Range("D" & Rows.Count).End(xlUp).Row
Windows("Test.xlsm").Activate
For i = DerLig_projet To 1 Step -1
Windows("W12.xlsx").Activate
Sheets("Metier").Copy After:=Feuil1
ActiveSheet.Name = f2.Cells(i, 3)
For Each Ws In Worksheets
For h = 2 To DerLig_Liste
For j = 4 To 9
Buisness = Ws.Cells(1, j)
DerLig_DT = Ws.Range("J" & Rows.Count).End(xlUp).Row
DerLig_Jalon = Ws.Range("B" & Rows.Count).End(xlUp).Row
For s = 2 To DeLig_Document
For k = 2 To DerLig_DT
For n = 2 To DerLig_Milestone
For c = 2 To DerLig_Jalon
Do While f1.Cells(h, "C") = Ws.Name
If f1.Cells(n, "B") = Ws.Cells(1, j) And f1.Cells(n, "B") = Ws.Cells(c, "B") And f1.Cells(s, "D") = Ws.Cells(k, "J") And f1.Cells(h, "A") = Ws.Cells(1, j) Then
Ws.Cells(k, j) = 1
End If
h = h + 1
j = j + 1
s = s + 1
k = k + 1
n = n + 1
c = c + 1
Loop
Next c
Next n
Next k
Next s
Next j
Next h
Next Ws
Next i
Set f1 = Nothing
Set f2 = Nothing
End Sub |
Merci par avance pour votre aide ;)