Excel, VBA, onglet et copier coller

colaplsus

XLDnaute Nouveau
Bonjour à tous forumeurs et forumeuses comment allez vous en ce début d'apres midi ?

Voila, je demande votre aide, pour m'aider à résoudre un sacré probleme pas piqué des hanetons ^^
Cela se passe sur une badgeuse, dont le programme a pour but de traiter les données, imaginez au départ j'ai ceci :
Entrée Date heure Matricule
0 mercredi 1 juin 2011 08:46 4037
1 mercredi 1 juin 2011 12:28 4037
2 mercredi 1 juin 2011 13:34 4037
3 mercredi 1 juin 2011 17:31 4037
0 mercredi 1 juin 2011 07:10 4127
1 mercredi 1 juin 2011 12:20 4127
2 mercredi 1 juin 2011 13:14 4127
3 mercredi 1 juin 2011 16:44 4127
0 mercredi 1 juin 2011 07:41 4128
1 mercredi 1 juin 2011 12:00 4128
2 mercredi 1 juin 2011 13:55 4128
3 mercredi 1 juin 2011 17:04 4128
1 mercredi 1 juin 2011 13:56 4149
0 mercredi 1 juin 2011 13:56 4149
1 mercredi 1 juin 2011 18:04 4149
0 mercredi 1 juin 2011 08:49 4150
1 mercredi 1 juin 2011 12:03 4150
2 mercredi 1 juin 2011 13:14 4150
3 mercredi 1 juin 2011 17:42 4150

Editer le messageAccepter cette réponseRapporter le messageRépondre en citant le messageExcel, VBA, onglet et copier coller
de colpasus » 27 Juin 2011, 16:02

Bonjour à tous les forumeurs, j'ai un problème sur le programme que je suis en train de concevoir, cela se passe sur une badgeuse, dont le programme a pour but de traiter les données, imaginez au départ j'ai ceci :
Entrée Date heure Matricule
0 mercredi 1 juin 2011 08:46 4037
1 mercredi 1 juin 2011 12:28 4037
2 mercredi 1 juin 2011 13:34 4037
3 mercredi 1 juin 2011 17:31 4037
0 mercredi 1 juin 2011 07:10 4127
1 mercredi 1 juin 2011 12:20 4127
2 mercredi 1 juin 2011 13:14 4127
3 mercredi 1 juin 2011 16:44 4127
0 mercredi 1 juin 2011 07:41 4128
1 mercredi 1 juin 2011 12:00 4128
2 mercredi 1 juin 2011 13:55 4128
3 mercredi 1 juin 2011 17:04 4128
1 mercredi 1 juin 2011 13:56 4149
0 mercredi 1 juin 2011 13:56 4149
1 mercredi 1 juin 2011 18:04 4149
0 mercredi 1 juin 2011 08:49 4150
1 mercredi 1 juin 2011 12:03 4150
2 mercredi 1 juin 2011 13:14 4150
3 mercredi 1 juin 2011 17:42 4150

et pour chaque matricule, un onglet doit être crée, et retourner cela :
Date Entrée 1 Sortie 1 Entrée 2 Sortie 2
mercredi 1 juin 2011 12:14:00 13:12:00 17:04:00 16:15:00
lundi 6 juin 2011 12:08:00 13:09:00 17:43:00 16:12:00
mardi 7 juin 2011 08:21:00 12:18:00 13:22:00 17:41:00
mercredi 8 juin 2011 13:15:00 14:23:00 18:27:00 16:12:00

Et comme vous le voyez, tout est décalé, alors oui j'ai le code généraliste, mais je n'ai pas pris en compte le fait que certaines personnes oublieraient de passer a la badgeuse, ce qui cause un immense décalage, et pour compenser cela, je me sens perdu, donc si quelqu'un a idée voici le code :
Code:
Sub matricule()
    Dim NomEmployer(29) As String
Dim NumereauMatricule(29) As String
Dim K As String
Dim enplacementEmployer(29) 'je ne savais pas comment appeler la variable

NomEmployer(11) = "TOTO" ' nom employer et matricule correspondant
NumereauMatricule(11) = 4127
NomEmployer(12) = "TATA"
NumereauMatricule(12) = 4164
NomEmployer(13) = "TITI"
NumereauMatricule(13) = 4145
NomEmployer(14) = "ROMINET"
NumereauMatricule(14) = 4149
NomEmployer(15) = "CALC"
NumereauMatricule(15) = 4158
NomEmployer(16) = "DARK"
NumereauMatricule(16) = 4163
NomEmployer(17) = "VADOR"
NumereauMatricule(17) = 4171
NomEmployer(18) = "DARKE"
NumereauMatricule(18) = 4146
NomEmployer(19) = "SIDIOUS"
NumereauMatricule(19) = 4169
NomEmployer(20) = "AFIN"
NumereauMatricule(20) = 4173
NomEmployer(21) = "DE"
NumereauMatricule(21) = 4166
NomEmployer(22) = "FAIRE"
NumereauMatricule(22) = 1
NomEmployer(23) = "UN"
NumereauMatricule(23) = 4069
NomEmployer(24) = "EXEMPLE"
NumereauMatricule(24) = 4037
NomEmployer(25) = "EN"
NumereauMatricule(25) = 1247
NomEmployer(26) = "LISANT"
NumereauMatricule(26) = 4157
NomEmployer(27) = "CELA"
NumereauMatricule(27) = 4150
NomEmployer(28) = "SOYEZ"
NumereauMatricule(28) = 4128
 
EmployerTotal = 28 'nombre total d'employer

For i = 11 To EmployerTotal
On Error Resume Next 'création des 18 feuilles par rapport à employertotal, pour un employé une feuille de créer
  Sheets(NumereauMatricule(i)).Delete
   On Error GoTo 0
   Sheets.Add
   ActiveSheet.Name = NumereauMatricule(i) 'on correspond au nom de la page ,le matricule de l'employé
  With ActiveWorkbook.Worksheets(NumereauMatricule(i))
    Columns("A:A").Select
    Selection.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
    Columns("G:G").ColumnWidth = 14.29
    Columns("A:A").ColumnWidth = 22.86
        .Range("A11").Value = "Date"
        .Range("B11").Value = "entrée 1"
        .Range("C11").Value = "sortie 1"
        .Range("D11").Value = "entrée 2"
        .Range("E11").Value = "sortie 2"
        .Range("F11").Value = "Total/jour"
        .Range("G11").Value = "Total/semaine"
        Columns("I:I").ColumnWidth = 15.29
        .Range("A1").Value = "DEVINE"
        .Range("A3").Value = "LA RUE"
        .Range("A5").Value = "OU"
        .Range("A7").Value = NomEmployer(i)
        .Range("F7").Value = "numéro de carte : " & NumereauMatricule(i)
        .Range("F5").Value = "LA VILLE"
          .Range("A11:G37").Select
        .Range("A37").Value = "Total du mois"
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
          
End With
Next i 'on passe au rang suivant
Dim j As Integer
 Dim l As Integer
j = 12
For i = 10 To EmployerTotal
enplacementEmployer(i) = 12
Next i
matriculePressedent = "0"
 
While ActiveWorkbook.Worksheets("Feuil1").Cells(j, 1).Value <> "" 'tant qu'il existe une valeur dans la colonne A la boucle continue
   For i = 10 To EmployerTotal
        If ActiveWorkbook.Worksheets("Feuil1").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
        l = 2
        enplacementEmployer(MPressedent) = enplacementEmployer(MPressedent) + 1
    End If
    
    ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).NumberFormatLocal = "hh:mm:ss"
    ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 3).Value 'on copie les cellules de la pointeuse vers la nouvelle
   ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), 1).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 2).Value
    l = l + 1
    j = j + 1
    ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).NumberFormatLocal = "hh:mm:ss"
    ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 3).Value
    ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), 1).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 2).Value
    j = j + 1
    matriculePressedent = K
    MPressedent = m
 
Wend

End Sub

Et pour ceux qui le déirent voici aussi le fichier joint

Et voici le fichier demandé apres avoir lancé la macro "matricule", comme vous le verrez, quand il manque une entrée, il y a un décalage sur les onglets

Et pour faire simple, quelqu'un saurait il comment éviter ce décalage ?
 

Pièces jointes

  • Mai(1).xlsm
    40.2 KB · Affichages: 68
Dernière édition:

BrunoM45

XLDnaute Barbatruc
Re : Excel, VBA, onglet et copier coller

Bonjour,

Merci de bien vouloir éditer ton 1er post et modifier ton fichier en respectant la charte du forum
Lien supprimé

3 - La Rédaction de la Question
c) ...
En ce qui concerne la possibilité de pièces jointes, elles devront être explicites et comporter juste un exemple de votre problème, pas une application entière ...De plus les données contenues devront être 'purgées' de toute information confidentielle.

A+
 

Discussions similaires

Réponses
9
Affichages
398
Réponses
1
Affichages
725

Membres actuellement en ligne

Statistiques des forums

Discussions
302 236
Messages
2 001 688
Membres
215 256
dernier inscrit
Adso