Excel, VBA, onglet et copier coller

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 :

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) = "MAILLE Delphine" ' nom employer et matricule correspondant
NumereauMatricule(11) = 4127
NomEmployer(12) = "ROQUIER Nicolas"
NumereauMatricule(12) = 4164
NomEmployer(13) = "ADAMS-MAYHEW Séverine"
NumereauMatricule(13) = 4145
NomEmployer(14) = "DI GENNARO Dominique"
NumereauMatricule(14) = 4149
NomEmployer(15) = "MONFET Jordan"
NumereauMatricule(15) = 4158
NomEmployer(16) = "BOSSUWE Alice"
NumereauMatricule(16) = 4163
NomEmployer(17) = "POTEREL Alice"
NumereauMatricule(17) = 4171
NomEmployer(18) = "DUPREZ Denis"
NumereauMatricule(18) = 4146
NomEmployer(19) = "BENZIANE Mounia"
NumereauMatricule(19) = 4169
NomEmployer(20) = "ANOUN Carole"
NumereauMatricule(20) = 4173
NomEmployer(21) = "BELMADI Rahmouna"
NumereauMatricule(21) = 4166
NomEmployer(22) = "COURTI Eric"
NumereauMatricule(22) = 1
NomEmployer(23) = "DUPREZ Sandrine"
NumereauMatricule(23) = 4069
NomEmployer(24) = "ELIOT Stéphane"
NumereauMatricule(24) = 4037
NomEmployer(25) = "GAROT Céline"
NumereauMatricule(25) = 1247
NomEmployer(26) = "HASLE Coralie"
NumereauMatricule(26) = 4157
NomEmployer(27) = "LECOSSIER Frédéric"
NumereauMatricule(27) = 4150
NomEmployer(28) = "PEROTIN Laetitia"
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 = "ALEFPA"
        .Range("A3").Value = "199/201 RUE COLBERT"
        .Range("A5").Value = "T1000 - Etat de fiche de présence"
        .Range("A7").Value = NomEmployer(i)
        .Range("F7").Value = "numéro de carte : " & NumereauMatricule(i)
        .Range("F5").Value = "du 1/05 au 31/05"
          .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

Bonsoir Colpasus le forum

si tu veux bien m'envoyer un fichier à traiter je regarde cela de plus prêt

par contre STP dans le fichier tu remets les matricules et les noms correspondant

a te relire

a+

papou

Bonjour

Un essai

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

-- 29 Juin 2011, 08:47 --

BanzaÏ le principe de ton code est le meme que le mien, mais je voudrais surtout qu'il gere le fait qu'un employer peut oublier une entrée et prenne en compte ce décalage pour que tout le reste ne soit pas atteint.

-- 29 Juin 2011, 10:32 --

Personne pour m'aider ? =(

13mai.xlsm (95.61 Ko)

Bonjour

Un essai

C'est bon cela fonctionne enfin =D, je te remercie beaucoup Banzai

Bonjour

Toi tu es fort (ou alors il y a un bug sur ce forum)

A 13:20 tu marques

colpasus a écrit :

C'est bon cela fonctionne enfin =D, je te remercie beaucoup Banzai

Et le fichier que j'ai posté à 12:53 n'a pas été téléchargé ===> Chercher l'erreur

Donc tu as trouvé une autre solution

colapsus ok

Non mais je te parlais de celui d'hier, je l'ai retraité pour qu'il fonctionne ^^

je vais voir le plus récent maintenant

Rechercher des sujets similaires à "vba onglet copier coller"