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 118 119 120 121 122 123
| Sub Transfert()
Dim LigneCible As Long, ligneOrigine As Long
Dim LigneFin As Long
Dim Données As Variant
Dim Nom As String
Dim Mois As String
Dim Trimestre As String
Dim Année As String
Dim Nbjourstrav As String
Dim Nbconges As String
Dim Nbformation As String
Dim Pointeur As Long
Dim CheminBdd As String
'Lecture des infos dans la fiche de saisie
Nom = ThisWorkbook.Worksheets("fiche_activite").Range("B3").Value
Mois = ThisWorkbook.Worksheets("fiche_activite").Range("E3").Value
Trimestre = ThisWorkbook.Worksheets("fiche_activite").Range("E4").Value
Année = ThisWorkbook.Worksheets("fiche_activite").Range("E5").Value
Nbjourstrav = ThisWorkbook.Worksheets("fiche_activite").Range("D6").Value
Nbconges = ThisWorkbook.Worksheets("fiche_activite").Range("D8").Value
Nbformation = ThisWorkbook.Worksheets("fiche_activite").Range("D10").Value
LigneFin = ThisWorkbook.Worksheets("fiche_activite").Range("A2000").End(xlUp).Row
Données = ThisWorkbook.Worksheets("fiche_activite").Range("A14:e" & LigneFin)
'Ecriture dans l'onglet Base de données BDD
' Le chemin sera à modifier en fonction de l'application
CheminBdd = "u:/test/"
If Left(Dir(CheminBdd & "BDD.*"), 4) <> "BDD." Then
Workbooks.Add
Worksheets.Add
ActiveSheet.Name = "BDD"
Worksheets("BDD").Range("A1") = "Nom"
Worksheets("BDD").Range("B1") = "Mois"
Worksheets("BDD").Range("C1") = "Trimestre"
Worksheets("BDD").Range("D1") = "Année"
Worksheets("BDD").Range("E1") = "Nbjourstrav"
Worksheets("BDD").Range("F1") = "Nbconges"
Worksheets("BDD").Range("G1") = "Nbformation"
ThisWorkbook.Worksheets("fiche_activite").Range("A13:E13").Copy Destination:=Worksheets("BDD").Range("H1:L1")
ActiveWorkbook.SaveAs Filename:=CheminBdd & "BDD.xls"
Else
Workbooks.Open Filename:=CheminBdd & "BDD.xls"
End If
LigneCible = Workbooks("BDD.xls").Worksheets("BDD").Range("A65535").End(xlUp).Row + 1
' Boucle répétitive pour le nom
For Pointeur = LigneCible To LigneCible + UBound(Données) - 1
Range("BDD!A" & Pointeur) = Année
Range("BDD!B" & Pointeur) = Trimestre
Range("BDD!C" & Pointeur) = Mois
Range("BDD!D" & Pointeur) = Nom
Range("BDD!E" & Pointeur) = Nbjourstrav
Range("BDD!F" & Pointeur) = Nbconges
Range("BDD!G" & Pointeur) = Nbformation
Next Pointeur
'Copie globale de la zone saisie
Workbooks("BDD.xls").Worksheets("BDD").Range("H" & LigneCible & ":L" & LigneCible + UBound(Données) - 1) = Données
Workbooks("BDD.xls").Close True
MsgBox "Merci la fiche du mois de " & Range("D3") & " a été transférée à Véronique"
End Sub
Sub Transfert_CT()
Dim LigneCible As Long, ligneOrigine As Long
Dim LigneFin As Long
Dim Données As Variant
Dim Nom As String
Dim Mois As String
Dim Trimestre As String
Dim Année As String
Dim Nbjourstrav As String
Dim Nbconges As String
Dim Nbformation As String
Dim Pointeur As Long
Dim CheminBdd As String
'Lecture des infos dans la fiche de saisie
Nom = ThisWorkbook.Worksheets("fiche_activite").Range("B3").Value
Mois = ThisWorkbook.Worksheets("fiche_activite").Range("E3").Value
Trimestre = ThisWorkbook.Worksheets("fiche_activite").Range("E4").Value
Année = ThisWorkbook.Worksheets("fiche_activite").Range("E5").Value
Nbjourstrav = ThisWorkbook.Worksheets("fiche_activite").Range("D6").Value
Nbconges = ThisWorkbook.Worksheets("fiche_activite").Range("D8").Value
Nbformation = ThisWorkbook.Worksheets("fiche_activite").Range("D10").Value
LigneFin = ThisWorkbook.Worksheets("fiche_activite").Range("A2000").End(xlUp).Row
Données = ThisWorkbook.Worksheets("fiche_activite").Range("A14:e" & LigneFin)
'Ecriture dans l'onglet Base de données BDD
' Le chemin sera à modifier en fonction de l'application
CheminBdd = "u:/"
If Left(Dir(CheminBdd & "BDD.*"), 4) <> "BDD." Then
Workbooks.Add
Worksheets.Add
ActiveSheet.Name = "BDD"
Worksheets("BDD").Range("A1") = "Nom"
Worksheets("BDD").Range("B1") = "Mois"
Worksheets("BDD").Range("C1") = "Trimestre"
Worksheets("BDD").Range("D1") = "Année"
Worksheets("BDD").Range("E1") = "Nbjourstrav"
Worksheets("BDD").Range("F1") = "Nbconges"
Worksheets("BDD").Range("G1") = "Nbformation"
ThisWorkbook.Worksheets("fiche_activite").Range("A13:E13").Copy Destination:=Worksheets("BDD").Range("H1:L1")
ActiveWorkbook.SaveAs Filename:=CheminBdd & "BDD.xls"
Else
Workbooks.Open Filename:=CheminBdd & "BDD.xls"
End If
LigneCible = Workbooks("BDD.xls").Worksheets("BDD").Range("A65535").End(xlUp).Row + 1
' Boucle répétitive pour le nom
For Pointeur = LigneCible To LigneCible + UBound(Données) - 1
Range("BDD!A" & Pointeur) = Année
Range("BDD!B" & Pointeur) = Trimestre
Range("BDD!C" & Pointeur) = Mois
Range("BDD!D" & Pointeur) = Nom
Range("BDD!E" & Pointeur) = Nbjourstrav
Range("BDD!F" & Pointeur) = Nbconges
Range("BDD!G" & Pointeur) = Nbformation
Next Pointeur
'Copie globale de la zone saisie
Workbooks("BDD.xls").Worksheets("BDD").Range("H" & LigneCible & ":L" & LigneCible + UBound(Données) - 1) = Données
Workbooks("BDD.xls").Close True
MsgBox "Merci la fiche du mois de " & Range("D3") & " a été sur votre fichier personnel"
End Sub |
Partager