Forcer la sélection de lignes

S

stephane.quinquis

XLDnaute Junior
Bonjour le forum,

Encore un autre post.
J'ai deux feuilles: inventaire production et mise en carton. L'opérateur est amené à transférer des données de l'inventaire production vers la mise en carton.

Je voudrais faire une gestion des erreurs de façon à ce que la macro fonctionne seulement si l'opérateur sélectionne une ligne entière( en gros que si par mégarde il ne sélectionne rien et sur une cellule cette cellule ne se copie pas).

Merci d'avance.

Inventaire production
Cijoint.fr - Service gratuit de dépôt de fichiers

Code:
Code: 
Sub allerversmiseencarton()
'
' allerversmiseencarton Macro
' Macro enregistrée le 11/06/2010 par quinquis
'
ActiveSheet.Unprotect "293"
Sheets("Mise en carton").Unprotect "293"
With Selection
    .Copy Destination:=Feuil2.Range("C65536").End(xlUp).Offset(1, 0)
    .Delete
End With
Range("G7:G200").Select
Selection.Locked = False
ActiveSheet.Protect "293"
Sheets("Mise en carton").Protect "293"
End Sub
 
Trier par date Trier par votes
Papou-net

Papou-net

XLDnaute Barbatruc
Re : Forcer la sélection de lignes

Bonjour stephane.quinquis,

J'ai complété ton code ainsi :

Code: 
Sub allerversmiseencarton()
'
' allerversmiseencarton Macro
' Macro enregistrée le 11/06/2010 par quinquis
'
[COLOR="Red"][B]With Sheets("Inventaire production")
    Set cel = Intersect(.Range("A7:F" & .Range("C65536").End(xlUp).Row), ActiveCell)
    If cel Is Nothing Then Exit Sub
End With[/B][/COLOR]

ActiveSheet.Unprotect "293"
Sheets("Mise en carton").Unprotect "293"
[COLOR="Red"][B]With ActiveCell.EntireRow[/B][/COLOR]
    [B][COLOR="Red"].Copy Destination:=Feuil2.Cells(Range("C65536").End(xlUp).Row + 1, 1)[/COLOR][/B]
    .Delete
End With
Range("G7:G200").Select
Selection.Locked = False
ActiveSheet.Protect "293"
Sheets("Mise en carton").Protect "293"
End Sub

Et j'ai modifié la ligne Destination:=... car elle posait problème.

De cette façon, il n'est pas nécessaire de sélectionner une ligne entière, la sélection d'une seule cellule dans la ligne suffit.

Espérant avoir répondu.

Cordialement.
 
Vote positif 0 Vote négatif
S

stephane.quinquis

XLDnaute Junior
Re : Forcer la sélection de lignes

Bonjour Papou,

Merci tout d'abord. J'ai testé ta solution et j'ai qq problèmes.
J'aimerai que l'incrémentation se fasse à partir de la première cellule non vide or il me colle les données en ligne 12 et non en ligne 7.
L'incrémentation se fait du bas vers le haut et j'aimerai du haut vers le bas.
Je voulais savori s'il était possible également de sélectionner plusieurs données.
Merci.
 
Vote positif 0 Vote négatif
Papou-net

Papou-net

XLDnaute Barbatruc
Re : Forcer la sélection de lignes

stephane.quinquis à dit:
Bonjour Papou,

Merci tout d'abord. J'ai testé ta solution et j'ai qq problèmes.
J'aimerai que l'incrémentation se fasse à partir de la première cellule non vide or il me colle les données en ligne 12 et non en ligne 7.
L'incrémentation se fait du bas vers le haut et j'aimerai du haut vers le bas.
Je voulais savori s'il était possible également de sélectionner plusieurs données.
Merci.
Cliquez pour agrandir...

Re-bonjour stephane,

OK, la solution ci-dessous devrait te convenir: :

Code: 
Sub allerversmiseencarton()
'
' allerversmiseencarton Macro
' Macro enregistrée le 11/06/2010 par quinquis
'
With Sheets("Inventaire production")
    Set cel = Intersect(.Range("A7:F" & .Range("C65536").End(xlUp).Row), ActiveCell)
    If cel Is Nothing Then Exit Sub
End With

ActiveSheet.Unprotect "293"
Sheets("Mise en carton").Unprotect "293"
[COLOR="Red"][B]With Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row)
    .Copy Destination:=Feuil2.Range("C65536").End(xlUp).Offset(1, 0)[/B][/COLOR]
    .Delete
End With
Range("G7:G200").Select
Selection.Locked = False
ActiveSheet.Protect "293"
Sheets("Mise en carton").Protect "293"
End Sub

Par contre, que veux-tu dire par "sélectionner plusieurs données" ? Est-ce que tu voudrais copier plusieurs lignes à la fois ?

Dans l'attente de te lire.

Cordialement.
 
Vote positif 0 Vote négatif
Papou-net

Papou-net

XLDnaute Barbatruc
Re : Forcer la sélection de lignes

stephane.quinquis à dit:
Bonjour Papou,


Un grand merci encore. Ta solution est excellente. Concernant la sélection de données, c'est exactement ce que tu as dis, j'aimerais copier plusieurs lignes à la fois.
Cliquez pour agrandir...

Bonjour stephane,

J'ai donc ajouté une boucle qui détermine la première et la dernière ligne de la sélection, puis effectue le transfert des lignes sélectionnées.

Voici le listing :

Code: 
Sub allerversmiseencarton()
'
' allerversmiseencarton Macro
' Macro enregistrée le 11/06/2010 par quinquis
'
[COLOR="Red"][B]Dim LgDeb As Integer, LgFin As Integer, Lg As Integer[/B][/COLOR]

With Sheets("Inventaire production")
    Set cel = Intersect(.Range("A7:F" & .Range("C65536").End(xlUp).Row), ActiveCell)
    If cel Is Nothing Then Exit Sub
    [COLOR="Red"][B]For Lg = 1 To Selection.Rows.Count
      If Lg = 1 Then LgDeb = Selection.Row
      LgFin = LgDeb + Lg - 1
    Next[/B][/COLOR]
End With

ActiveSheet.Unprotect "293"
Sheets("Mise en carton").Unprotect "293"
With Range("A" & [COLOR="Red"][B]LgDeb[/B][/COLOR] & ":F" & [COLOR="Red"][B]LgFin[/B][/COLOR])
    .Copy Destination:=Feuil2.Range("C65536").End(xlUp).Offset(1, 0)
    .Delete
End With
Range("G7:G200").Select
Selection.Locked = False
ActiveSheet.Protect "293"
Sheets("Mise en carton").Protect "293"
End Sub

Bonne journée.

Cordialement.
 
Vote positif 0 Vote négatif
Papou-net

Papou-net

XLDnaute Barbatruc
Re : Forcer la sélection de lignes

stephane.quinquis à dit:
Merci encore. Excellente ta solution!!!
Cliquez pour agrandir...

Encore plus simple, en supprimant la boucle :

Code: 
Sub allerversmiseencarton()
'
' allerversmiseencarton Macro
' Macro enregistrée le 11/06/2010 par quinquis
'

With Sheets("Inventaire production")
    Set cel = Intersect(.Range("A7:F" & .Range("C65536").End(xlUp).Row), ActiveCell)
    If cel Is Nothing Then Exit Sub
End With

ActiveSheet.Unprotect "293"
Sheets("Mise en carton").Unprotect "293"
With Range("A" & [COLOR="Red"][B]Selection.Row[/B][/COLOR] & ":F" & [COLOR="Red"][B]Selection.Row + Selection.Rows.Count - 1[/B][/COLOR])
    .Copy Destination:=Feuil2.Range("C65536").End(xlUp).Offset(1, 0)
    .Delete
End With
Range("G7:G200").Select
Selection.Locked = False
ActiveSheet.Protect "293"
Sheets("Mise en carton").Protect "293"
End Sub

Cordialement.
 
Vote positif 0 Vote négatif
S

stephane.quinquis

XLDnaute Junior
Re : Forcer la sélection de lignes

Re

Juste un détail. Si je filtre mes infos avant d'utiliser mon bouton macro, quand j'utilise le bouton avec le filtre activé, il me met un message du style: " Voulez vous supprimer la ligne entière?" mais la macro fonctionne toujours.
Est-il possible de supprimer ce message d'erreur.

Merci
 
Vote positif 0 Vote négatif
Papou-net

Papou-net

XLDnaute Barbatruc
Re : Forcer la sélection de lignes

stephane.quinquis à dit:
Re

Juste un détail. Si je filtre mes infos avant d'utiliser mon bouton macro, quand j'utilise le bouton avec le filtre activé, il me met un message du style: " Voulez vous supprimer la ligne entière?" mais la macro fonctionne toujours.
Est-il possible de supprimer ce message d'erreur.

Merci
Cliquez pour agrandir...

Re :

Ajoutes les 2 lignes bleues dans ton code :

Code: 
Sub allerversmiseencarton()
'
' allerversmiseencarton Macro
' Macro enregistrée le 11/06/2010 par quinquis
'
Dim LgDeb As Integer, LgFin As Integer, Lg As Integer

With Sheets("Inventaire production")
    Set cel = Intersect(.Range("A7:F" & .Range("C65536").End(xlUp).Row), ActiveCell)
    If cel Is Nothing Then Exit Sub
    For Lg = 1 To Selection.Rows.Count
      If Lg = 1 Then LgDeb = Selection.Row
      LgFin = LgDeb + Lg - 1
    Next
End With
[COLOR="RoyalBlue"][B]Application.DisplayAlerts = False[/B][/COLOR]
ActiveSheet.Unprotect "293"
Sheets("Mise en carton").Unprotect "293"
With Range("A" & LgDeb & ":F" & LgFin)
    .Copy Destination:=Feuil2.Range("C65536").End(xlUp).Offset(1, 0)
    .Delete
End With
Range("G7:G200").Select
Selection.Locked = False
[COLOR="Green"][COLOR="Red"][B]'ActiveSheet.Protect "293"[/B][/COLOR][/COLOR]
Sheets("Mise en carton").Protect "293"
[COLOR="RoyalBlue"][B]Application.DisplayAlerts = True[/B][/COLOR]
End Sub

ou bien :

Code: 
Sub allerversmiseencarton()
'
' allerversmiseencarton Macro
' Macro enregistrée le 11/06/2010 par quinquis
'

With Sheets("Inventaire production")
    Set cel = Intersect(.Range("A7:F" & .Range("C65536").End(xlUp).Row), ActiveCell)
    If cel Is Nothing Then Exit Sub
End With
[COLOR="RoyalBlue"][B]Application.DisplayAlerts = False[/B][/COLOR]
ActiveSheet.Unprotect "293"
Sheets("Mise en carton").Unprotect "293"
With Range("A" & Selection.Row & ":F" & Selection.Row + Selection.Rows.Count - 1)
    .Copy Destination:=Feuil2.Range("C65536").End(xlUp).Offset(1, 0)
    .Delete
End With
Range("G7:G200").Select
Selection.Locked = False
[COLOR="Green"][COLOR="Red"][B]'ActiveSheet.Protect "293"[/B][/COLOR][/COLOR]
Sheets("Mise en carton").Protect "293"
[COLOR="RoyalBlue"][B]Application.DisplayAlerts = True[/B][/COLOR]
End Sub

Par contre, j'ai mis la ligne rouge en commentaires, car après le transfert, la protection empêche de réutiliser le filtre.

A plus.

Cordialement.
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
196
marie3107
M
A
  • Question
XL 2010 Correction macro supprimant les lignes avec '' 0 '' en début de tableau
Réponses
2
Affichages
326
Acritas
A
A
  • Question
XL 2013 Utilisation de la fonction "Case" dans VBA
Réponses
12
Affichages
1 K
AnjyD
A
Usine à gaz
  • Résolu(e)
Microsoft 365 CurrentRegion : sélection de cellules
2 3 4
Réponses
46
Affichages
4 K
laurent950
laurent950
A
  • Question
Microsoft 365 Problème, ma macro change la plage de cellule dans une autre feuille
Réponses
6
Affichages
1 K
akira21
A
F
  • Question
Microsoft 365 Protect/Unprotect
2
Réponses
18
Affichages
2 K
TooFatBoy
TooFatBoy
D
  • Question
Microsoft 365 Grouper ne fonctionne pas avec un une macro qui rajoute des lignes
Réponses
1
Affichages
591
Diego-Andres
D
K
  • Question
Microsoft 365 Code VBA - Erreur
Réponses
1
Affichages
561
Staple1600
Staple1600
F
  • Résolu(e)
XL 2016 Protection de nombreuses cellules sur plusieurs pages
Réponses
2
Affichages
642
Flo68
F
S
  • Résolu(e)
XL 2013 Méthode de sélection alternative
Réponses
4
Affichages
2 K
stage_ferrit
S

Membres actuellement en ligne

10 membres et 107 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 397
Messages
2 088 058
Membres
103 710
dernier inscrit
kty