Changer de colonne dans une nouvelle feuille

colaplsus

XLDnaute Nouveau
Bonjour à tous
Voici mon probleme, je dois dans le cadre de mon stage réaliser une pointeuse, tout va bien, à partir des données brutes, j'ai crée une macro qui pour chaque matricule cree un onglet au nom de ce matricule dans lesquels les données sont rangées, mais ils me demandent avant cette étape que tout soit remis dans le bon ordre.
Pour mieux comprendre, voici le fichier ci-joint.
et voici le code au depart
Code:
    Dim NomEmployer(10) As String
Dim NumereauMatricule(10) As String
Dim K As String
Dim enplacementEmployer(10) 'je ne savais pas comment appeler la variable
 
NomEmployer(1) = "toto" ' nom employer et matricule qui corespond
NumereauMatricule(1) = 4127
NomEmployer(2) = "tata"
NumereauMatricule(2) = 4144
NomEmployer(3) = "tarzen"
NumereauMatricule(3) = 4145
NomEmployer(4) = "DD"
NumereauMatricule(4) = 4149
NomEmployer(5) = "moi"
NumereauMatricule(5) = 4158
NomEmployer(6) = "toi"
NumereauMatricule(6) = 4163
NomEmployer(7) = "lui"
NumereauMatricule(7) = 4164
NomEmployer(8) = "elle"
NumereauMatricule(8) = 4166
NomEmployer(9) = "autre"
NumereauMatricule(9) = 4169
 
EmployerTotal = 9 'nombre total d'employer
 
For i = 1 To EmployerTotal
On Error Resume Next 'créé les feuil feuil
   Sheets(NumereauMatricule(i)).Delete
   On Error GoTo 0
   Sheets.Add
   ActiveSheet.Name = NumereauMatricule(i)
   With ActiveWorkbook.Worksheets(NumereauMatricule(i))
        .Range("A1").Value = "Date"
        .Range("B1").Value = "entrée 1"
        .Range("C1").Value = "sortie 1"
        .Range("D1").Value = "entrée 2"
        .Range("E1").Value = "sortie 2"
        .Range("F1").Value = "Total"
        .Range("i1").Value = NumereauMatricule(i)
        .Range("i2").Value = NomEmployer(i)
    End With
Next i
 
 
 
 
j = 2
For i = 1 To EmployerTotal
enplacementEmployer(i) = 2
Next i
matriculePressedent = "0"
 
While ActiveWorkbook.Worksheets("Pointeuse 1").Cells(j, 1).Value <> "" 'boucle tent qu'il y a des valeur, on ne sort pas de la boucle
    For i = 1 To EmployerTotal
        If ActiveWorkbook.Worksheets("Pointeuse 1").Cells(j, 4).Value = NumereauMatricule(i) Then
            K = NumereauMatricule(i)
            M = i
        End If
    Next i
    
    If matriculePressedent = K And L = 3 Then
        L = 4
    Else
        ' tu peux placé le code ici
        ' ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(M),1).Value = date
        L = 2
        enplacementEmployer(MPressedent) = enplacementEmployer(MPressedent) + 1
    End If
    
    ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(M), L).NumberFormatLocal = "hh:mm"
    ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(M), L).Value = ActiveWorkbook.Worksheets("Pointeuse 1").Cells(j, 3).Value
    ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(M), 1).Value = ActiveWorkbook.Worksheets("Pointeuse 1").Cells(j, 2).Value
    L = L + 1
    j = j + 1
    ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(M), L).NumberFormatLocal = "hh:mm"
    ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(M), L).Value = ActiveWorkbook.Worksheets("Pointeuse 1").Cells(j, 3).Value
    ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(M), 1).Value = ActiveWorkbook.Worksheets("Pointeuse 1").Cells(j, 2).Value
    j = j + 1
    matriculePressedent = K
    MPressedent = M
 
Wend
End Sub
 

Pièces jointes

  • Essai.xlsx
    8.9 KB · Affichages: 48
  • Essai.xlsx
    8.9 KB · Affichages: 47
  • Essai.xlsx
    8.9 KB · Affichages: 50

Statistiques des forums

Discussions
312 332
Messages
2 087 365
Membres
103 528
dernier inscrit
maro