Déclaration existante

Le
Richard
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
--
Richard
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
isabelle
Le #19353241
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



MichDenis
Le #19353421
Bonjour Richard,

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" 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

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
--
Richard
Richard
Le #19353411
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
>



Publicité
Poster une réponse
Anonyme