Je tente de supprimer une ligne dans plusieur classeurs sous une même macro
et ca ne fonctionne pas. Voici la macro et où est l'erreur?
Sub Recherche_paste_endemployment2()
'Recherche_paste_endemployment Macro
'Macro enregistré le 2008-03-16 par RICHARD FORTIN
'
'Ajoute une ligne du Registre Employés Licenciés
Sheets("Employés licenciés").Select
Range("A" & Range("A65536").End(xlUp).Row).Resize(2, 20).FillDown
On Error Resume Next
'Copie les infos sur l'employés licenciés
Sheets("Fiche employé").Select
Range("O2:AA2").Select
Selection.Copy
'colle les infos ds la base données
Sheets("Employés licenciés").Select
Range("A" & Range("A1500").End(xlUp).Row).Select
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'efface la ligne dans (registre coût indirect)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Coût indirect")
.Activate
ligne = 12
While .Cells(ligne, 1) <> ""
If .Cells(ligne, 1) = id Then
.Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre conciliation)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Conciliation")
.Activate
ligne = 12
While .Cells(ligne, 9) <> ""
If .Cells(ligne, 9) = id Then
.Cells(ligne, 9).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre DÉDUCTION COURANTES)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Déductions courante")
.Activate
ligne = 12
While .Cells(ligne, 1) <> ""
If .Cells(ligne, 1) = id Then
.Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre DÉDUCTION BUDGET)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Déductions Budget")
.Activate
ligne = 12
While .Cells(ligne, 1) <> ""
If .Cells(ligne, 1) = id Then
.Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre courant)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Registre (courant)")
.Activate
ligne = 12
While .Cells(ligne, 4) <> ""
If .Cells(ligne, 4) = id Then
.Cells(ligne, 4).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'copie colonne CJ du registre courant
Sheets("Registre (Courant)").Select
Range("cj1").Select 'copie la formule originale dans la ligne 1
Selection.Copy
Range("cj12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("CJ12").Select 'copie les formules jusqu'à la dernière ligne
Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown)),
Type:=xlFillDefault
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
isabelle
bonjour Richard,
cette ligne :
Dim id, ligne As Integer
doit apparaitre une seule fois dans la macro, présentement elle est apparaitre 5 fois
isabelle
Richard a écrit :
Bonjours à tous
Je tente de supprimer une ligne dans plusieur classeurs sous une même macro et ca ne fonctionne pas. Voici la macro et où est l'erreur?
Sub Recherche_paste_endemployment2()
'Recherche_paste_endemployment Macro 'Macro enregistré le 2008-03-16 par RICHARD FORTIN '
'Ajoute une ligne du Registre Employés Licenciés Sheets("Employés licenciés").Select Range("A" & Range("A65536").End(xlUp).Row).Resize(2, 20).FillDown On Error Resume Next
'Copie les infos sur l'employés licenciés Sheets("Fiche employé").Select Range("O2:AA2").Select Selection.Copy
'colle les infos ds la base données Sheets("Employés licenciés").Select Range("A" & Range("A1500").End(xlUp).Row).Select ActiveCell.Offset(0, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse
'efface la ligne dans (registre coût indirect)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Coût indirect") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre conciliation)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Conciliation") .Activate ligne = 12 While .Cells(ligne, 9) <> "" If .Cells(ligne, 9) = id Then .Cells(ligne, 9).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre DÉDUCTION COURANTES)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Déductions courante") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre DÉDUCTION BUDGET)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Déductions Budget") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre courant)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Registre (courant)") .Activate ligne = 12 While .Cells(ligne, 4) <> "" If .Cells(ligne, 4) = id Then .Cells(ligne, 4).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'copie colonne CJ du registre courant Sheets("Registre (Courant)").Select Range("cj1").Select 'copie la formule originale dans la ligne 1 Selection.Copy Range("cj12").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse
Range("CJ12").Select 'copie les formules jusqu'à la dernière ligne Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown)), Type:=xlFillDefault
doit apparaitre une seule fois dans la macro,
présentement elle est apparaitre 5 fois
isabelle
Richard a écrit :
Bonjours à tous
Je tente de supprimer une ligne dans plusieur classeurs sous une même macro
et ca ne fonctionne pas. Voici la macro et où est l'erreur?
Sub Recherche_paste_endemployment2()
'Recherche_paste_endemployment Macro
'Macro enregistré le 2008-03-16 par RICHARD FORTIN
'
'Ajoute une ligne du Registre Employés Licenciés
Sheets("Employés licenciés").Select
Range("A" & Range("A65536").End(xlUp).Row).Resize(2, 20).FillDown
On Error Resume Next
'Copie les infos sur l'employés licenciés
Sheets("Fiche employé").Select
Range("O2:AA2").Select
Selection.Copy
'colle les infos ds la base données
Sheets("Employés licenciés").Select
Range("A" & Range("A1500").End(xlUp).Row).Select
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
'efface la ligne dans (registre coût indirect)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Coût indirect")
.Activate
ligne = 12
While .Cells(ligne, 1) <> ""
If .Cells(ligne, 1) = id Then
.Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre conciliation)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Conciliation")
.Activate
ligne = 12
While .Cells(ligne, 9) <> ""
If .Cells(ligne, 9) = id Then
.Cells(ligne, 9).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre DÉDUCTION COURANTES)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Déductions courante")
.Activate
ligne = 12
While .Cells(ligne, 1) <> ""
If .Cells(ligne, 1) = id Then
.Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre DÉDUCTION BUDGET)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Déductions Budget")
.Activate
ligne = 12
While .Cells(ligne, 1) <> ""
If .Cells(ligne, 1) = id Then
.Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre courant)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Registre (courant)")
.Activate
ligne = 12
While .Cells(ligne, 4) <> ""
If .Cells(ligne, 4) = id Then
.Cells(ligne, 4).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'copie colonne CJ du registre courant
Sheets("Registre (Courant)").Select
Range("cj1").Select 'copie la formule originale dans la ligne 1
Selection.Copy
Range("cj12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("CJ12").Select 'copie les formules jusqu'à la dernière ligne
Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown)),
Type:=xlFillDefault
doit apparaitre une seule fois dans la macro, présentement elle est apparaitre 5 fois
isabelle
Richard a écrit :
Bonjours à tous
Je tente de supprimer une ligne dans plusieur classeurs sous une même macro et ca ne fonctionne pas. Voici la macro et où est l'erreur?
Sub Recherche_paste_endemployment2()
'Recherche_paste_endemployment Macro 'Macro enregistré le 2008-03-16 par RICHARD FORTIN '
'Ajoute une ligne du Registre Employés Licenciés Sheets("Employés licenciés").Select Range("A" & Range("A65536").End(xlUp).Row).Resize(2, 20).FillDown On Error Resume Next
'Copie les infos sur l'employés licenciés Sheets("Fiche employé").Select Range("O2:AA2").Select Selection.Copy
'colle les infos ds la base données Sheets("Employés licenciés").Select Range("A" & Range("A1500").End(xlUp).Row).Select ActiveCell.Offset(0, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse
'efface la ligne dans (registre coût indirect)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Coût indirect") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre conciliation)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Conciliation") .Activate ligne = 12 While .Cells(ligne, 9) <> "" If .Cells(ligne, 9) = id Then .Cells(ligne, 9).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre DÉDUCTION COURANTES)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Déductions courante") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre DÉDUCTION BUDGET)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Déductions Budget") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre courant)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Registre (courant)") .Activate ligne = 12 While .Cells(ligne, 4) <> "" If .Cells(ligne, 4) = id Then .Cells(ligne, 4).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'copie colonne CJ du registre courant Sheets("Registre (Courant)").Select Range("cj1").Select 'copie la formule originale dans la ligne 1 Selection.Copy Range("cj12").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse
Range("CJ12").Select 'copie les formules jusqu'à la dernière ligne Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown)), Type:=xlFillDefault
A ) Les déclarations des variables se font en début de procédure Dim Id, Ligne As Long, DerLig As Long
B ) Quand tu veux supprimer des lignes sur une plage de données, tu dois faire une boucle en débutant par la dernière ligne jusqu'à la première (12) dans ton cas. Un exemple de procédure ressemblerait à ceci : 'Extrait tiré de ta procédure mais réorganisé un peu... Id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Coût indirect") .Activate ligne = 12 derlig = .Cells(Cells.Rows.Count, 1).End(xlUp).Row While derlig >= ligne If .Cells(derlig, 1) = Id Then .Cells(derlig, 1).EntireRow.Delete Shift:=xlUp End If derlig = derlig - 1 Wend End With
C ) quand tu veux tester une procédure, il est préférable de ne pas avoir de "On Error Resume Next" en début de procédure. De plus, si on ajoute cette ligne de code, on se doit de savoir quel est le type d'erreur dont on veut se prémunir, cela empêche d'avoir des surprises.
"Richard" a écrit dans le message de groupe de discussion : Bonjours à tous
Je tente de supprimer une ligne dans plusieur classeurs sous une même macro et ca ne fonctionne pas. Voici la macro et où est l'erreur?
Sub Recherche_paste_endemployment2()
'Recherche_paste_endemployment Macro 'Macro enregistré le 2008-03-16 par RICHARD FORTIN '
'Ajoute une ligne du Registre Employés Licenciés Sheets("Employés licenciés").Select Range("A" & Range("A65536").End(xlUp).Row).Resize(2, 20).FillDown On Error Resume Next
'Copie les infos sur l'employés licenciés Sheets("Fiche employé").Select Range("O2:AA2").Select Selection.Copy
'colle les infos ds la base données Sheets("Employés licenciés").Select Range("A" & Range("A1500").End(xlUp).Row).Select ActiveCell.Offset(0, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse
'efface la ligne dans (registre coût indirect)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Coût indirect") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre conciliation)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Conciliation") .Activate ligne = 12 While .Cells(ligne, 9) <> "" If .Cells(ligne, 9) = id Then .Cells(ligne, 9).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre DÉDUCTION COURANTES)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Déductions courante") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre DÉDUCTION BUDGET)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Déductions Budget") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre courant)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Registre (courant)") .Activate ligne = 12 While .Cells(ligne, 4) <> "" If .Cells(ligne, 4) = id Then .Cells(ligne, 4).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'copie colonne CJ du registre courant Sheets("Registre (Courant)").Select Range("cj1").Select 'copie la formule originale dans la ligne 1 Selection.Copy Range("cj12").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse
Range("CJ12").Select 'copie les formules jusqu'à la dernière ligne Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown)), Type:=xlFillDefault
A ) Les déclarations des variables se font en début de procédure
Dim Id, Ligne As Long, DerLig As Long
B ) Quand tu veux supprimer des lignes sur une plage de données,
tu dois faire une boucle en débutant par la dernière ligne jusqu'à
la première (12) dans ton cas. Un exemple de procédure ressemblerait
à ceci :
'Extrait tiré de ta procédure mais réorganisé un peu...
Id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Coût indirect")
.Activate
ligne = 12
derlig = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
While derlig >= ligne
If .Cells(derlig, 1) = Id Then
.Cells(derlig, 1).EntireRow.Delete Shift:=xlUp
End If
derlig = derlig - 1
Wend
End With
C ) quand tu veux tester une procédure, il est préférable
de ne pas avoir de "On Error Resume Next" en début
de procédure. De plus, si on ajoute cette ligne de code,
on se doit de savoir quel est le type d'erreur dont on
veut se prémunir, cela empêche d'avoir des surprises.
"Richard" <Richard@discussions.microsoft.com> a écrit dans le message de groupe de
discussion : 7F6EFAED-6D5B-4451-9C17-F3FBE53C282E@microsoft.com...
Bonjours à tous
Je tente de supprimer une ligne dans plusieur classeurs sous une même macro
et ca ne fonctionne pas. Voici la macro et où est l'erreur?
Sub Recherche_paste_endemployment2()
'Recherche_paste_endemployment Macro
'Macro enregistré le 2008-03-16 par RICHARD FORTIN
'
'Ajoute une ligne du Registre Employés Licenciés
Sheets("Employés licenciés").Select
Range("A" & Range("A65536").End(xlUp).Row).Resize(2, 20).FillDown
On Error Resume Next
'Copie les infos sur l'employés licenciés
Sheets("Fiche employé").Select
Range("O2:AA2").Select
Selection.Copy
'colle les infos ds la base données
Sheets("Employés licenciés").Select
Range("A" & Range("A1500").End(xlUp).Row).Select
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
'efface la ligne dans (registre coût indirect)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Coût indirect")
.Activate
ligne = 12
While .Cells(ligne, 1) <> ""
If .Cells(ligne, 1) = id Then
.Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre conciliation)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Conciliation")
.Activate
ligne = 12
While .Cells(ligne, 9) <> ""
If .Cells(ligne, 9) = id Then
.Cells(ligne, 9).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre DÉDUCTION COURANTES)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Déductions courante")
.Activate
ligne = 12
While .Cells(ligne, 1) <> ""
If .Cells(ligne, 1) = id Then
.Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre DÉDUCTION BUDGET)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Déductions Budget")
.Activate
ligne = 12
While .Cells(ligne, 1) <> ""
If .Cells(ligne, 1) = id Then
.Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'efface la ligne dans (registre courant)
Dim id, ligne As Integer
id = Worksheets("Fiche employé").Cells(29, 6).Value
With Worksheets("Registre (courant)")
.Activate
ligne = 12
While .Cells(ligne, 4) <> ""
If .Cells(ligne, 4) = id Then
.Cells(ligne, 4).EntireRow.Delete Shift:=xlUp
End If
ligne = ligne + 1
Wend
End With
'copie colonne CJ du registre courant
Sheets("Registre (Courant)").Select
Range("cj1").Select 'copie la formule originale dans la ligne 1
Selection.Copy
Range("cj12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("CJ12").Select 'copie les formules jusqu'à la dernière ligne
Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown)),
Type:=xlFillDefault
A ) Les déclarations des variables se font en début de procédure Dim Id, Ligne As Long, DerLig As Long
B ) Quand tu veux supprimer des lignes sur une plage de données, tu dois faire une boucle en débutant par la dernière ligne jusqu'à la première (12) dans ton cas. Un exemple de procédure ressemblerait à ceci : 'Extrait tiré de ta procédure mais réorganisé un peu... Id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Coût indirect") .Activate ligne = 12 derlig = .Cells(Cells.Rows.Count, 1).End(xlUp).Row While derlig >= ligne If .Cells(derlig, 1) = Id Then .Cells(derlig, 1).EntireRow.Delete Shift:=xlUp End If derlig = derlig - 1 Wend End With
C ) quand tu veux tester une procédure, il est préférable de ne pas avoir de "On Error Resume Next" en début de procédure. De plus, si on ajoute cette ligne de code, on se doit de savoir quel est le type d'erreur dont on veut se prémunir, cela empêche d'avoir des surprises.
"Richard" a écrit dans le message de groupe de discussion : Bonjours à tous
Je tente de supprimer une ligne dans plusieur classeurs sous une même macro et ca ne fonctionne pas. Voici la macro et où est l'erreur?
Sub Recherche_paste_endemployment2()
'Recherche_paste_endemployment Macro 'Macro enregistré le 2008-03-16 par RICHARD FORTIN '
'Ajoute une ligne du Registre Employés Licenciés Sheets("Employés licenciés").Select Range("A" & Range("A65536").End(xlUp).Row).Resize(2, 20).FillDown On Error Resume Next
'Copie les infos sur l'employés licenciés Sheets("Fiche employé").Select Range("O2:AA2").Select Selection.Copy
'colle les infos ds la base données Sheets("Employés licenciés").Select Range("A" & Range("A1500").End(xlUp).Row).Select ActiveCell.Offset(0, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse
'efface la ligne dans (registre coût indirect)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Coût indirect") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre conciliation)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Conciliation") .Activate ligne = 12 While .Cells(ligne, 9) <> "" If .Cells(ligne, 9) = id Then .Cells(ligne, 9).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre DÉDUCTION COURANTES)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Déductions courante") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre DÉDUCTION BUDGET)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Déductions Budget") .Activate ligne = 12 While .Cells(ligne, 1) <> "" If .Cells(ligne, 1) = id Then .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'efface la ligne dans (registre courant)
Dim id, ligne As Integer id = Worksheets("Fiche employé").Cells(29, 6).Value With Worksheets("Registre (courant)") .Activate ligne = 12 While .Cells(ligne, 4) <> "" If .Cells(ligne, 4) = id Then .Cells(ligne, 4).EntireRow.Delete Shift:=xlUp End If ligne = ligne + 1 Wend End With
'copie colonne CJ du registre courant Sheets("Registre (Courant)").Select Range("cj1").Select 'copie la formule originale dans la ligne 1 Selection.Copy Range("cj12").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse
Range("CJ12").Select 'copie les formules jusqu'à la dernière ligne Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown)), Type:=xlFillDefault
doit apparaitre une seule fois dans la macro, présentement elle est apparaitre 5 fois
isabelle
Richard a écrit : > Bonjours à tous > > Je tente de supprimer une ligne dans plusieur classeurs sous une même macro > et ca ne fonctionne pas. Voici la macro et où est l'erreur? > > Sub Recherche_paste_endemployment2() > > 'Recherche_paste_endemployment Macro > 'Macro enregistré le 2008-03-16 par RICHARD FORTIN > ' > > 'Ajoute une ligne du Registre Employés Licenciés > Sheets("Employés licenciés").Select > Range("A" & Range("A65536").End(xlUp).Row).Resize(2, 20).FillDown > On Error Resume Next > > 'Copie les infos sur l'employés licenciés > Sheets("Fiche employé").Select > Range("O2:AA2").Select > Selection.Copy > > 'colle les infos ds la base données > Sheets("Employés licenciés").Select > Range("A" & Range("A1500").End(xlUp).Row).Select > ActiveCell.Offset(0, 2).Select > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > SkipBlanks _ > :úlse, Transpose:úlse > > 'efface la ligne dans (registre coût indirect) > > Dim id, ligne As Integer > id = Worksheets("Fiche employé").Cells(29, 6).Value > With Worksheets("Coût indirect") > .Activate > ligne = 12 > While .Cells(ligne, 1) <> "" > If .Cells(ligne, 1) = id Then > .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp > End If > ligne = ligne + 1 > Wend > End With > > 'efface la ligne dans (registre conciliation) > > Dim id, ligne As Integer > id = Worksheets("Fiche employé").Cells(29, 6).Value > With Worksheets("Conciliation") > .Activate > ligne = 12 > While .Cells(ligne, 9) <> "" > If .Cells(ligne, 9) = id Then > .Cells(ligne, 9).EntireRow.Delete Shift:=xlUp > End If > ligne = ligne + 1 > Wend > End With > > 'efface la ligne dans (registre DÉDUCTION COURANTES) > > Dim id, ligne As Integer > id = Worksheets("Fiche employé").Cells(29, 6).Value > With Worksheets("Déductions courante") > .Activate > ligne = 12 > While .Cells(ligne, 1) <> "" > If .Cells(ligne, 1) = id Then > .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp > End If > ligne = ligne + 1 > Wend > End With > > 'efface la ligne dans (registre DÉDUCTION BUDGET) > > Dim id, ligne As Integer > id = Worksheets("Fiche employé").Cells(29, 6).Value > With Worksheets("Déductions Budget") > .Activate > ligne = 12 > While .Cells(ligne, 1) <> "" > If .Cells(ligne, 1) = id Then > .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp > End If > ligne = ligne + 1 > Wend > End With > > 'efface la ligne dans (registre courant) > > Dim id, ligne As Integer > id = Worksheets("Fiche employé").Cells(29, 6).Value > With Worksheets("Registre (courant)") > .Activate > ligne = 12 > While .Cells(ligne, 4) <> "" > If .Cells(ligne, 4) = id Then > .Cells(ligne, 4).EntireRow.Delete Shift:=xlUp > End If > ligne = ligne + 1 > Wend > End With > > > > 'copie colonne CJ du registre courant > Sheets("Registre (Courant)").Select > Range("cj1").Select 'copie la formule originale dans la ligne 1 > Selection.Copy > Range("cj12").Select > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > SkipBlanks _ > :úlse, Transpose:úlse > > Range("CJ12").Select 'copie les formules jusqu'à la dernière ligne > Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown)), > Type:=xlFillDefault > > Sheets("Fiche employé").Select > Rows("42:48").Select > Selection.EntireRow.Hidden = True > Rows("49:75").Select > Selection.EntireRow.Hidden = False > Range("D1").Select > > > > End Sub >
C'est ça un novice
Merci, ça fonctionne
--
Richard
"isabelle" a écrit :
bonjour Richard,
cette ligne :
Dim id, ligne As Integer
doit apparaitre une seule fois dans la macro,
présentement elle est apparaitre 5 fois
isabelle
Richard a écrit :
> Bonjours à tous
>
> Je tente de supprimer une ligne dans plusieur classeurs sous une même macro
> et ca ne fonctionne pas. Voici la macro et où est l'erreur?
>
> Sub Recherche_paste_endemployment2()
>
> 'Recherche_paste_endemployment Macro
> 'Macro enregistré le 2008-03-16 par RICHARD FORTIN
> '
>
> 'Ajoute une ligne du Registre Employés Licenciés
> Sheets("Employés licenciés").Select
> Range("A" & Range("A65536").End(xlUp).Row).Resize(2, 20).FillDown
> On Error Resume Next
>
> 'Copie les infos sur l'employés licenciés
> Sheets("Fiche employé").Select
> Range("O2:AA2").Select
> Selection.Copy
>
> 'colle les infos ds la base données
> Sheets("Employés licenciés").Select
> Range("A" & Range("A1500").End(xlUp).Row).Select
> ActiveCell.Offset(0, 2).Select
> Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> SkipBlanks _
> :úlse, Transpose:úlse
>
> 'efface la ligne dans (registre coût indirect)
>
> Dim id, ligne As Integer
> id = Worksheets("Fiche employé").Cells(29, 6).Value
> With Worksheets("Coût indirect")
> .Activate
> ligne = 12
> While .Cells(ligne, 1) <> ""
> If .Cells(ligne, 1) = id Then
> .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
> End If
> ligne = ligne + 1
> Wend
> End With
>
> 'efface la ligne dans (registre conciliation)
>
> Dim id, ligne As Integer
> id = Worksheets("Fiche employé").Cells(29, 6).Value
> With Worksheets("Conciliation")
> .Activate
> ligne = 12
> While .Cells(ligne, 9) <> ""
> If .Cells(ligne, 9) = id Then
> .Cells(ligne, 9).EntireRow.Delete Shift:=xlUp
> End If
> ligne = ligne + 1
> Wend
> End With
>
> 'efface la ligne dans (registre DÉDUCTION COURANTES)
>
> Dim id, ligne As Integer
> id = Worksheets("Fiche employé").Cells(29, 6).Value
> With Worksheets("Déductions courante")
> .Activate
> ligne = 12
> While .Cells(ligne, 1) <> ""
> If .Cells(ligne, 1) = id Then
> .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
> End If
> ligne = ligne + 1
> Wend
> End With
>
> 'efface la ligne dans (registre DÉDUCTION BUDGET)
>
> Dim id, ligne As Integer
> id = Worksheets("Fiche employé").Cells(29, 6).Value
> With Worksheets("Déductions Budget")
> .Activate
> ligne = 12
> While .Cells(ligne, 1) <> ""
> If .Cells(ligne, 1) = id Then
> .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp
> End If
> ligne = ligne + 1
> Wend
> End With
>
> 'efface la ligne dans (registre courant)
>
> Dim id, ligne As Integer
> id = Worksheets("Fiche employé").Cells(29, 6).Value
> With Worksheets("Registre (courant)")
> .Activate
> ligne = 12
> While .Cells(ligne, 4) <> ""
> If .Cells(ligne, 4) = id Then
> .Cells(ligne, 4).EntireRow.Delete Shift:=xlUp
> End If
> ligne = ligne + 1
> Wend
> End With
>
>
>
> 'copie colonne CJ du registre courant
> Sheets("Registre (Courant)").Select
> Range("cj1").Select 'copie la formule originale dans la ligne 1
> Selection.Copy
> Range("cj12").Select
> Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> SkipBlanks _
> :úlse, Transpose:úlse
>
> Range("CJ12").Select 'copie les formules jusqu'à la dernière ligne
> Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown)),
> Type:=xlFillDefault
>
> Sheets("Fiche employé").Select
> Rows("42:48").Select
> Selection.EntireRow.Hidden = True
> Rows("49:75").Select
> Selection.EntireRow.Hidden = False
> Range("D1").Select
>
>
>
> End Sub
>
doit apparaitre une seule fois dans la macro, présentement elle est apparaitre 5 fois
isabelle
Richard a écrit : > Bonjours à tous > > Je tente de supprimer une ligne dans plusieur classeurs sous une même macro > et ca ne fonctionne pas. Voici la macro et où est l'erreur? > > Sub Recherche_paste_endemployment2() > > 'Recherche_paste_endemployment Macro > 'Macro enregistré le 2008-03-16 par RICHARD FORTIN > ' > > 'Ajoute une ligne du Registre Employés Licenciés > Sheets("Employés licenciés").Select > Range("A" & Range("A65536").End(xlUp).Row).Resize(2, 20).FillDown > On Error Resume Next > > 'Copie les infos sur l'employés licenciés > Sheets("Fiche employé").Select > Range("O2:AA2").Select > Selection.Copy > > 'colle les infos ds la base données > Sheets("Employés licenciés").Select > Range("A" & Range("A1500").End(xlUp).Row).Select > ActiveCell.Offset(0, 2).Select > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > SkipBlanks _ > :úlse, Transpose:úlse > > 'efface la ligne dans (registre coût indirect) > > Dim id, ligne As Integer > id = Worksheets("Fiche employé").Cells(29, 6).Value > With Worksheets("Coût indirect") > .Activate > ligne = 12 > While .Cells(ligne, 1) <> "" > If .Cells(ligne, 1) = id Then > .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp > End If > ligne = ligne + 1 > Wend > End With > > 'efface la ligne dans (registre conciliation) > > Dim id, ligne As Integer > id = Worksheets("Fiche employé").Cells(29, 6).Value > With Worksheets("Conciliation") > .Activate > ligne = 12 > While .Cells(ligne, 9) <> "" > If .Cells(ligne, 9) = id Then > .Cells(ligne, 9).EntireRow.Delete Shift:=xlUp > End If > ligne = ligne + 1 > Wend > End With > > 'efface la ligne dans (registre DÉDUCTION COURANTES) > > Dim id, ligne As Integer > id = Worksheets("Fiche employé").Cells(29, 6).Value > With Worksheets("Déductions courante") > .Activate > ligne = 12 > While .Cells(ligne, 1) <> "" > If .Cells(ligne, 1) = id Then > .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp > End If > ligne = ligne + 1 > Wend > End With > > 'efface la ligne dans (registre DÉDUCTION BUDGET) > > Dim id, ligne As Integer > id = Worksheets("Fiche employé").Cells(29, 6).Value > With Worksheets("Déductions Budget") > .Activate > ligne = 12 > While .Cells(ligne, 1) <> "" > If .Cells(ligne, 1) = id Then > .Cells(ligne, 1).EntireRow.Delete Shift:=xlUp > End If > ligne = ligne + 1 > Wend > End With > > 'efface la ligne dans (registre courant) > > Dim id, ligne As Integer > id = Worksheets("Fiche employé").Cells(29, 6).Value > With Worksheets("Registre (courant)") > .Activate > ligne = 12 > While .Cells(ligne, 4) <> "" > If .Cells(ligne, 4) = id Then > .Cells(ligne, 4).EntireRow.Delete Shift:=xlUp > End If > ligne = ligne + 1 > Wend > End With > > > > 'copie colonne CJ du registre courant > Sheets("Registre (Courant)").Select > Range("cj1").Select 'copie la formule originale dans la ligne 1 > Selection.Copy > Range("cj12").Select > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > SkipBlanks _ > :úlse, Transpose:úlse > > Range("CJ12").Select 'copie les formules jusqu'à la dernière ligne > Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown)), > Type:=xlFillDefault > > Sheets("Fiche employé").Select > Rows("42:48").Select > Selection.EntireRow.Hidden = True > Rows("49:75").Select > Selection.EntireRow.Hidden = False > Range("D1").Select > > > > End Sub >