Discussion :

[dmbenjamin]

Bonjour,

J'ai bricolé une macro pour mettre à jour des fichier du personnel. Pour ce faire il copie le matricule dans un tableau pour le coller dans un autre tableau avec formule de vlookup qui va donner les connexions, pauses, et autres de l'employer. Ces informations sont ensuite copiées / collées valeur sur le fichier du personnel correspondant au nom à coté du matricule dans le tableau où il va le chercher.

La macro est assez imparfaite car pour l'instant je dois lui dire à chaque fois où aller copier le matricule suivant (en rouge) au lieu de lui dire de prendre le sivant dans la cellule du dessous et terminer en tapant update sur la même ligne dans une cellule du tableau (en orange). La macro est donc très volumineuse, j'ai du employer un macro d'ensemble qui lance des macros succèssiblement car l'opération doit se répéter pour bien faire +- 300 fois (300 matricules). J'aimerais faire une boucle jusqu'à ce qu'il arrive à une cellule vide (la fin du tableau).

Voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub UPDATE_Accent_1()

    Sheets("Payroll UPDATE").Select
    Range("A4").Select
    Selection.Copy
    Sheets("bco UPDATE").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C9:T372").Select
    Selection.Copy
    Range("B1").Select
    Workbooks.Open Filename:= _
        Range("A6") _
        , UpdateLinks:=0
    ActiveWindow.Visible = False
    Windows(Range("B3") & "_" & Range("A2") & "_" & Range("A3") & "_Interview.xlsx").Visible = True
    Sheets("LISTING Aanwezigheid 2018").Select
    Range("J62").Select
    ActiveWindow.ScrollRow = 1
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D11").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWindow.Close
    Sheets("Payroll UPDATE").Select
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "UPDATED"
    
    Range("A5").Select
    Selection.Copy
    Sheets("bco UPDATE").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C9:T372").Select
    Selection.Copy
    Range("B1").Select
    Workbooks.Open Filename:= _
        Range("A6") _
        , UpdateLinks:=0
    ActiveWindow.Visible = False
    Windows(Range("B3") & "_" & Range("A2") & "_" & Range("A3") & "_Interview.xlsx").Visible = True
    Sheets("LISTING Aanwezigheid 2018").Select
    Range("J62").Select
    ActiveWindow.ScrollRow = 1
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D11").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWindow.Close
    Sheets("Payroll UPDATE").Select
    Range("D5").Select
    ActiveCell.FormulaR1C1 = "UPDATED"

etc...


D'avance merci beaucoup.

[Zekraoui_Jakani]

Votre code a besoin d'être amélioré; pour vous permettre de le lancer avec un seul code générique, je l'ai adapté ainsi (à tester):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub UPDATE_Accent_1()
 
Dim j As Integer: j = 0 'new
Application.ScreenUpdating = False
On Error GoTo 150
 
 Do While True
    Sheets("Payroll UPDATE").Select
    Range("A4").Select 'variable
    ActiveCell.Offset(j, 0).Activate 'new
    If ActiveCell.Offset(j, 0) = "" Then Exit Do
    Selection.Copy
    Sheets("bco UPDATE").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 
    Range("C9:T372").Select
    Selection.Copy
    Range("B1").Select
    Workbooks.Open Filename:=Range("A6"), UpdateLinks:=0
    ActiveWindow.Visible = False
    Windows(Range("B3") & "_" & Range("A2") & "_" & Range("A3") & "_Interview.xlsx").Visible = True
    Sheets("LISTING Aanwezigheid 2018").Select
    Range("J62").Select
    ActiveWindow.ScrollRow = 1
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 
    Range("D11").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWindow.Close
    Sheets("Payroll UPDATE").Select
    Range("D4").Select 'variable
    ActiveCell.Offset(j, 0).Activate 'new
    ActiveCell.FormulaR1C1 = "UPDATED"
    j = j + 1
 Loop
    MsgBox "Traitement terminé !", vbOKOnly, "Update Accent"
150     Application.ScreenUpdating = True
End Sub

[dmbenjamin]

Un grand merci!

Cela fonctionne patiellement à la perfection.

Il s'arret à A27 sans aucune explication et affiche malgré tout le message "Traitement terminé".
J'ai vérifié le fichier de l'employé en question et aucun soucis qui expliqerait l'arrêt de la macro, même si de toute manière avec la première version sans code générique il parvenait à mettre à jour.

[dmbenjamin]

J'ai changé le matricule de A28 pour voir si le problème vient de la fiche du personnel mais la macro s'arrête toujours au même endroit.

[Transitoire]

Bonjour, je me suis permis de rajouter un Message qui peut donner une information sur l'erreur. testez le?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub UPDATE_Accent_1() 
Dim j As Integer: j = 0 'new
Application.ScreenUpdating = False
On Error GoTo 150
 
 Do While True
    Sheets("Payroll UPDATE").Select
    Range("A4").Select 'variable
    ActiveCell.Offset(j, 0).Activate 'new
    If ActiveCell.Offset(j, 0) = "" Then 
       MsgBox "A " & j & " est egal nothing"  'Si le message Box s'affiche ca signifie que la cellule est égale à rien, raison de la sortie de la boucle.
       Exit Do
    End If
    Selection.Copy
    Sheets("bco UPDATE").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 
    Range("C9:T372").Select
    Selection.Copy
    Range("B1").Select
    Workbooks.Open Filename:=Range("A6"), UpdateLinks:=0
    ActiveWindow.Visible = False
    Windows(Range("B3") & "_" & Range("A2") & "_" & Range("A3") & "_Interview.xlsx").Visible = True
    Sheets("LISTING Aanwezigheid 2018").Select
    Range("J62").Select
    ActiveWindow.ScrollRow = 1
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 
    Range("D11").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWindow.Close
    Sheets("Payroll UPDATE").Select
    Range("D4").Select 'variable
    ActiveCell.Offset(j, 0).Activate 'new
    ActiveCell.FormulaR1C1 = "UPDATED"
    j = j + 1
 Loop
    MsgBox "Traitement terminé !", vbOKOnly, "Update Accent"
150     Application.ScreenUpdating = True
End Sub

Cordialement

[dmbenjamin]

Un résultat des plus métaphysique! Il annonce "A24 égla nothing" alors qu'il atteint toujours A27 et le valide par "UPDATED"

[Transitoire]

Bonsoir,
N'y aurait-il pas par hasard, une ou des lignes cachés ou du moins dont la hauteur serait = 0 ou 0,001
et donc une cellule qui serait égale a rien?
Bizarre, bizarre, vous avez dit bizarre!
Cordialement

[Transitoire]

Re bonsoir,

Un résultat des plus métaphysique! Il annonce "A24 égal nothing" alors qu'il atteint toujours A27 et le valide par "UPDATED"

Rien d'étonnant en fait ! En effet, A24, le 24 n'est pas le numéro de ligne, mais la valeur de j soit le numéro de boucle. Comme la boucle part de la ligne 4 , 24+ 4 =28 .
Il y a un problème sur la cellule A27 ou A28 elle doit donner une réponse "nothing" ?

Cordialement