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
| Sub CréerTrame()
Chemin = "U:\nouveau devis\"
Dim Cell As Range
Dim NQuantite, NCodeArticle As Integer
Dim DateDebutPrestation, DateLivraison As Date
Dim Texte, NoteInterne, NomTri As String
Dim wbDevis As Excel.Workbook
Dim wbTrame As Excel.Workbook
DateDebutPrestation = Format(Now + 1, "dd/mm/yyyy")
DateLivraison = Format(Now + 30, "dd/mm/yyyy")
Texte = Trame & Range("C7")
Set wbDevis = Workbooks.Open("D:\Users\u116533\Desktop\TEST\xxxx_xxxx_17_1259.xlsm")
Set wbTrame = Workbooks.Open("D:\Users\u116533\Desktop\TEST\xxxx-TFO-IDF-XXX-XXX-XXSXX.xlsx")
wbTrame.Activate
'*Recuperer Les informations nécessaires au devis *
wbDevis.Activate
'NomTri = Left("C9", 3) '*Récuperer le trigramme *
NomDevis = Range("C7").Value
NumIntervention = Range("F11").Value
Odeon = Range("C8").Value
G2R = Range("C13").Value
CodeImputation = Range("F9").Value
ControleurGestion = Range("F10").Value
NoteInterne = (NomDevis & "/" & Odeon & "/" & NumIntervention)
'*Boucle pour remplir le fichier trame *
wbTrame.Activate
Range("AC2") = NoteInterne
For i = 16 To 109
' Range("F" & i).Select
If IsEmpty(Range("F" & i)) = False Then
'Enregistrer les valeurs souhaitées'
wbDevis.Activate
'Coller les valeurs dans le fichier trame'
wbTrame.Sheets(1).Activate
Rows("51").Select
Selection.Copy
Rows(i & -14).Select
Selection.PasteSpecial
'Range("D" & (y + 1)) = NomTri
wbTrame.Sheets(1).Range("D" & (i - 14)) = wbDevis.Sheets(1).Range("C9")
'Range("E" & (y + 1)) = ControleurGestion
wbTrame.Sheets(1).Range("E" & (i - 14)) = wbDevis.Sheets(1).Range("F10").Value
'Range("H" & (y + 1)) = i
wbTrame.Sheets(1).Range("H" & (i - 14)) = i - 15
'Range("I" & (y + 1)) = Var2
wbTrame.Sheets(1).Range("I" & (i - 14)) = wbDevis.Sheets(1).Range("A" & i).Value
'Range("K" & (y + 1)) = DateLivraison
wbTrame.Sheets(1).Range("K" & (i - 14)) = DateLivraison
'Range("L" & (y + 1)) = Var1
wbTrame.Sheets(1).Range("L" & (i - 14)) = wbDevis.Sheets(1).Range("F" & i).Value
'Range("P" & (y + 1)) = G2R
wbTrame.Sheets(1).Range("P" & (i - 14)) = wbDevis.Sheets(1).Range("C13").Value
'Range("S" & (y + 1)) = CodeImputation
wbTrame.Sheets(1).Range("S" & (i - 14)) = wbDevis.Sheets(1).Range("F9").Value
'Range("U" & (y + 1)) = Odeon*
wbTrame.Sheets(1).Range("U" & i - 14) = wbDevis.Sheets(1).Range("C8").Value
'Range("W" & (y + 1)) = DateDebutPrestation
wbTrame.Sheets(1).Range("W" & i - 14) = DateDebutPrestation
End If
Next
End Sub |
Partager