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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
| pplication.ScreenUpdating = False ' pour cacher le processus
'pour savoir le nombre de feuille
ThisWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
nbfeuille = Worksheets.Count
'Copier les données de la feuille 2 vers la dernière feuille
ThisWorkbook.Sheets(2).Cells.Copy
ThisWorkbook.Sheets(nbfeuille).Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets(2).Range("A1:Z100").Delete
'donne un nom à mon onglet collé
nomfeuille = Mid(ThisWorkbook.Sheets(2).Name, 1, 3)
ThisWorkbook.Sheets(nbfeuille).Name = nomfeuille & -2008
' copier les données de la feuille 1 vers la feuille 2
ThisWorkbook.Sheets(1).Cells.Copy
ThisWorkbook.Sheets(2).Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
'donne un nom à mon onglet collé
nomfeuille = Mid(ThisWorkbook.Sheets(1).Name, 1, 3)
ThisWorkbook.Sheets(2).Name = nomfeuille & 2008
'Initialisations
strFPath = ""
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
'Boîte de selection du fichier source
With fDialog
.AllowMultiSelect = False 'Limite la selection à un seul fichier
.Filters.Add "Fichier Excel", "*.xls", 1
.Title = "Choisir un rapport"
.InitialView = msoFileDialogViewDetails
.Show
For Each varTemp In .SelectedItems 'Boucle au cas ou (sécurité)
strFPath = varTemp 'Assigne le chemin complet du ficher selectionné
Next varTemp
End With
'Ouvre le fichier source pour traitement futur
If strFPath <> "" Then
Set xlBook = Workbooks.Open(strFPath)
EchangerValeur xlBook ' Mets les données à jour
Application.Calculate ' refresh de nos valeurs
End If
Exit_GetSource:
'Libération
Set fDialog = Nothing
Set varTemp = Nothing
strFPath = ""
'Ferme la feuille qui est ouverte dans la variable s'il ya lieu
If Not (xlBook Is Nothing) Then xlBook.Close
Set xlBook = Nothing
Application.ScreenUpdating = True ' permets de voir le processus durant l'exécution
Exit Sub
Err_GetSource:
MsgBox "Une erreur est survenue dans la routine GetSource" & vbCrLf & vbCrLf & "Erreur technique NO : " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf & "Le traitement a du être interrompu!"
Resume 0 'Exit_GetSource
End Sub
Sub EchangerValeur(ByRef wbCache As Workbook)
Dim i As Integer ' Détermine la position de la ligne dans le fichier actif
Dim j As Integer ' Détermine la position de la colonne dans le fichier actif
Dim x As Integer ' Détermine la position de la ligne dans le fichier source
Dim y As Integer ' Détermine la position de la colonne dans le fichier source
Dim z As Integer ' Détermine la position des types du fichier source
Dim k As Integer ' Détermine la position afin de coller les formules dans le tableau suivant
i = 8
j = 4
For k = 6 To 40 Step 34
For z = 0 To 6 Step 3
For x = k + z To 20 + k + z Step 10
For y = 4 To 11
ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).Cells(i, j), ThisWorkbook.Sheets(1).Cells(i + 2, j)).Value = wbCache.ActiveSheet.Range(wbCache.ActiveSheet.Cells(x, y), wbCache.ActiveSheet.Cells(x + 2, y)).Value
j = j + 2
Next y
j = 4
i = i + 3
Next x
i = i + 1
Next z
i = i + 8
Next k
ThisWorkbook.Sheets(1).Cells(3, 1) = "Inscrire votre date ici"
End Sub |
formule dans une cellule, référence à une feuille
Répondre avec citation
Partager