suppréssion de ligne

F

faguer

XLDnaute Nouveau
Bonjour a tous
étant novice et n'ayant jamais eu de formation excel je faisait mai macro avec le formulaire et après avoir un petit peut compris je modifiait cela fonctionnais bien.
j'ai décider de transformer mes macro en utilisant activeX
et je bloque sur une action qui est celle de supprimer des lignes quand j'utilise le code tout seul il fonctionne trés bien


Private Sub CommandButton1_Click()
Sheets("commande").Select


'supprimer la protection a faire

'Suppréssion des lignes pour suprimer les page commandes si pas de ligne de commande
Dim Ligne As Long
For Ligne = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Cells(Ligne, "A") = "" Then Rows(Ligne).Delete
Next Ligne


ActiveSheet.Range("W8:AA39").Select
Selection.Cut
ActiveSheet.Range("R40").Select
ActiveSheet.Paste
ActiveSheet.Range("T8:V71").Select
Selection.Cut
ActiveSheet.Range("R72").Select
ActiveSheet.Paste
ActiveSheet.Range("S8:U135").Select
Selection.Cut
ActiveSheet.Range("R136").Select
ActiveSheet.Paste
ActiveSheet.Range("S200:S263").Select
Selection.Cut
ActiveSheet.Range("R264").Select
ActiveSheet.Paste
ActiveSheet.Range("R8:R349").Select
ActiveSheet.Range("R349").Activate
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Add Key:=ActiveSheet.Range( _
"R8:R327"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("commande").Sort
.SetRange Range("R8:R327")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("S8").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=R[1]C[-1],"""",RC[-1])"
ActiveSheet.Range("S8").Select
Selection.AutoFill Destination:=ActiveSheet.Range("S8:S245"), Type:=xlFillDefault
ActiveSheet.Range("S8:S245").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Add Key:=ActiveSheet.Range( _
"S8:S245"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("commande").Sort
.SetRange Range("S8:S245")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("commande").Sort.SortFields.Add Key:=ActiveSheet.Range("S8"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("commande").Sort
.SetRange Range("S8:S245")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("S8:S17").Select
Selection.Copy
ActiveSheet.Range("AZ1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("O1").Select
End Sub






Quand je le glisse dans la macro final il ne fonctionne pas

Private Sub CommandButton1_Click()
ActiveSheet.Unprotect ' suppréssion de la protection
Sheets("listing 2").Select
ActiveSheet.Range("i2:i5000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'suppression des produit sans quantiter
' création des page de commande
Sheets("commande").Select
ActiveSheet.Unprotect ' suppréssion de la protection
ActiveSheet.Rows("8:16").Select
Selection.Copy
ActiveSheet.Range("A17").Select
ActiveSheet.Paste
ActiveSheet.Range("A26").Select
ActiveSheet.Paste
ActiveSheet.Range("A35").Select
ActiveSheet.Paste
' selection de la zone d'impréssion
Application.CutCopyMode = False
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$6"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$a$1:$n$42"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 94
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
'reglage saut de page
Set ActiveSheet.HPageBreaks(2).Location = ActiveSheet.Range("A25")
Set ActiveSheet.HPageBreaks(1).Location = ActiveSheet.Range("A16")
Set ActiveSheet.HPageBreaks(3).Location = ActiveSheet.Range("A34")
'transfere des lignes de commandes
Sheets("listing 2").Select
ActiveSheet.Rows("2:6").Select
Selection.Copy
Sheets("commande").Select
ActiveSheet.Rows("8:8").Select
ActiveSheet.Range("E8").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("listing 2").Select
ActiveSheet.Rows("7:11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("commande").Select
ActiveSheet.Rows("17:17").Select
ActiveSheet.Range("E17").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("listing 2").Select
ActiveSheet.Rows("12:16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("commande").Select
ActiveSheet.Rows("26:26").Select
ActiveSheet.Range("E26").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("listing 2").Select
ActiveSheet.Rows("17:21").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("commande").Select
ActiveSheet.Rows("35:35").Select
ActiveSheet.Range("E35").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'format colonne l
ActiveSheet.Range("m8:m12").Select
ActiveSheet.Range("m8:m12,m17:m21").Select
ActiveSheet.Range("m17").Activate
ActiveSheet.Range("m8:m12,m17:m21,m26:m30").Select
ActiveSheet.Range("m26").Activate
ActiveSheet.Range("m8:m12,m17:m21,m26:m30,m35:m39").Select
ActiveSheet.Range("m35").Activate
With Selection
.HorizontalAlignment = xlJustify
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveSheet.Range("L6").Select
'format colonne E
ActiveSheet.Range("f8:f12,f17:f21").Select
ActiveSheet.Range("f17").Activate
ActiveSheet.Range("f8:E12,f17:f21,f26:f30").Select
ActiveSheet.Range("f26").Activate
ActiveSheet.Range("f8:E12,f17:f21,f26:f30,f35:f39").Select
ActiveSheet.Range("f35").Activate
With Selection
.HorizontalAlignment = xlJustify
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' remplissage de la colonne a afin de ne pas supprimer la page
ActiveSheet.Range("A1").Select
ActiveCell.FormulaR1C1 = "*"
ActiveSheet.Range("A1").Select
Selection.AutoFill Destination:=ActiveSheet.Range("A1:A15"), Type:=xlFillDefault
ActiveSheet.Range("A1:A15").Select
ActiveCell.FormulaR1C1 = "*"
ActiveSheet.Range("A16").Select
ActiveCell.FormulaR1C1 = "=IF(R17C[8]="""","""",""*"")"
ActiveSheet.Range("A16").Select
Selection.AutoFill Destination:=ActiveSheet.Range("A16:A24"), Type:=xlFillDefault
ActiveSheet.Range("A16:A24").Select
ActiveSheet.Range("A25").Select
ActiveCell.FormulaR1C1 = "=IF(R26C[8]="""","""",""*"")"
ActiveSheet.Range("A26").Select
ActiveSheet.Range("A25").Select
Selection.AutoFill Destination:=ActiveSheet.Range("A25:A33"), Type:=xlFillDefault
ActiveSheet.Range("A25:A33").Select
ActiveSheet.Range("A34").Select
ActiveCell.FormulaR1C1 = "=IF(R35C[8]="""","""",""*"")"
ActiveSheet.Range("A34").Select
Selection.AutoFill Destination:=ActiveSheet.Range("A34:A42"), Type:=xlFillDefault
ActiveSheet.Range("A34:A42").Select

'suppréssion des ligne sans *
'Suppréssion des lignes pour suprimer les page commandes si pas de ligne de commande
ActiveWorkbook.Sheets("commande").Activate
Dim Ligne As Long
For Ligne = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Cells(Ligne, "A") = "" Then Rows(Ligne).Delete
Next Ligne

' copier coller valeur
ActiveSheet.Columns("A:A").Select
ActiveSheet.Range("A22").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("B22").Select
Application.CutCopyMode = False
'somme ligne
ActiveSheet.Range("L8").Select
ActiveCell.FormulaR1C1 = "=RC[-3]*RC[-1]"
ActiveSheet.Range("L8").Select
Selection.AutoFill Destination:=ActiveSheet.Range("L8:L12"), Type:=xlFillDefault
ActiveSheet.Range("L8:L12").Select
Selection.Copy
ActiveSheet.Range("L17").Select
ActiveSheet.Paste
ActiveSheet.Range("L26").Select
ActiveSheet.Paste
ActiveSheet.Range("L35").Select
ActiveSheet.Paste
ActiveSheet.Range("M37").Select
Application.CutCopyMode = False
' somme depence
ActiveSheet.Range("L40").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-5]C[-11]=""*"",R[-5]C+R[-4]C+R[-3]C+R[-2]C+R[-1]C,"""")"
ActiveSheet.Range("L41").Select
ActiveSheet.Range("L31").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-5]C[-11]=""*"",R[-5]C+R[-4]C+R[-3]C+R[-2]C+R[-1]C,"""")"
ActiveSheet.Range("L32").Select
ActiveSheet.Range("L22").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-5]C[-11]=""*"",R[-5]C+R[-4]C+R[-3]C+R[-2]C+R[-1]C,"""")"
ActiveSheet.Range("L23").Select
ActiveSheet.Range("L13").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-5]C[-11]=""*"",R[-5]C+R[-4]C+R[-3]C+R[-2]C+R[-1]C,"""")"
ActiveSheet.Range("L14").Select

' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ' remettre la protection de la page
End Sub


je cherche depuis plus de 10 jours et la je comprend pas

merci de m'indiquer mon erreurs d'encodage et surtout de m'expliquer pourquoi sa bug



merci d’avance Bruno
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir

Pour suggestion
Une macro simple (sans boucle) pour supprimer les lignes si cellule en colonne A vide.
Code: 
Sub SupprimerLigneVideColonneA()
Application.ScreenUpdating = False
On Error Resume Next
Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(4).EntireRow.Delete
End Sub
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir

Rien ne passe...
Hum pas si sur ;)
Copies ces macros dans un classeur vide
Puis lance la macro nommée Test
Quelque chose s'est bien passé, non ?
Et ce n'est pas rien ;)
Code: 
Sub Test()
RemplirDesCellules "A1:K1"
MsgBox "Supprimer les lignes si cellule vide en colonne A?", vbInformation + vbOKOnly, "Test"
SupprimerLigneVideColonneA
End Sub
Private Sub RemplirDesCellules(adr$)
Sheets.Add
With Range(adr)
.FormulaR1C1 = "=REPT(CHAR(64+COLUMN()),3)&ROW()"
.Resize(2).AutoFill Destination:=Range("A1:K38"), Type:=xlFillDefault
End With: [A1:K38].Value = [A1:K38].Value
End Sub
Private Sub SupprimerLigneVideColonneA()
Application.ScreenUpdating = False
On Error Resume Next
Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(4).EntireRow.Delete
End Sub
 
Vote positif 0 Vote négatif
F

faguer

XLDnaute Nouveau
Staple1600 à dit:
Bonsoir

Rien ne passe...
Hum pas si sur ;)
Copies ces macros dans un classeur vide
Puis lance la macro nommée Test
Quelque chose s'est bien passé, non ?
Et ce n'est pas rien ;)
Code: 
Sub Test()
RemplirDesCellules "A1:K1"
MsgBox "Supprimer les lignes si cellule vide en colonne A?", vbInformation + vbOKOnly, "Test"
SupprimerLigneVideColonneA
End Sub
Private Sub RemplirDesCellules(adr$)
Sheets.Add
With Range(adr)
.FormulaR1C1 = "=REPT(CHAR(64+COLUMN()),3)&ROW()"
.Resize(2).AutoFill Destination:=Range("A1:K38"), Type:=xlFillDefault
End With: [A1:K38].Value = [A1:K38].Value
End Sub
Private Sub SupprimerLigneVideColonneA()
Application.ScreenUpdating = False
On Error Resume Next
Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(4).EntireRow.Delete
End Sub
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
F

faguer

XLDnaute Nouveau
Bonjour

j'avais aussi ce résultat avant comme expliquer dans ma demande d'aide quand j utilise le code tout seule il fonctionne bien,
quand le l’inclus dans ma suite de code il ne fonctionne pas.

en sachant que ce code a été fait a la base Contrôles de formulaire (et il fonctionnait bien)et que maintenant je le transforme en Contrôles active X

merci pour ton aide
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour

faguer
Peut-être serait-il temps pour toi de joindre une copie anonymisée de ton classeur (ou un extrait) afin qu'on puisse y voir plus clair et faire des tests sur nos PC, non ? ;)
NB: Fichier qui contiendra le code VBA que tu utilises actuellement.
 
Vote positif 0 Vote négatif
F

faguer

XLDnaute Nouveau
Bonjour
voici le fichier
on clique sur création commande puis on mets un chiffre dans la colonne quantité.

la macro qui ne fonctionne pas est sur le boutons "création de vos bon de commande" dans la page listing 2

la page je ce protege a chaque action mais il n'y a pas de mots de passe

merci pour votre aide
n'hésitez pas a critiqué ma façons de faire cela ne pourra que me faire grandir dans excel

Cordialement

bruno
 

Pièces jointes

  • bruno guichet unique test.zip
    1.8 MB · Affichages: 4
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir

Relis mon précédent message:
Je parlais d'une copie ou d'un extrait
Pas d'un fichier de plus de 10Mo avec un bordel pas possible dans le projet VBA
(Plus de trente modules!!!)

Quand j'ai voulu ouvrir ton classeur, mon Excel (dans un éclair de lucidité ;)) s'est auto-terminé...

Bref joins plutôt un fichier "light" créé pour l'occasion avec le strict nécessaire pour illustrer ton problème.

PS : En plus, ton fichier contient encore quelques traces de données confidentielles...
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir,

Ton classeur contient toujours 30 modules vides...
(je les ai supprimé et enregistrer ton classeur en *.xlsb)
Résultat (voir ci-dessous ;))
01Reduit.jpg

Ensuite, j'ai commencé à alléger ton code* (sans plus)
*: pour le moment, cela ne fait que la copie.
Peux-tu me dire si déjà le résultat est similaire à ce que fait ta macro initiale ?
(PS: j'ai testé sur ton fichier et sans erreur, donc cela devrait être de même sur ton PC)
NB: Teste sur le dernier fichier exemple de ton fil en supprimant ta macro existante (juste le temps du test)
VB: 
Private Sub CommandButton1_Click()
Dim i&
ActiveSheet.Unprotect  ' suppréssion de la protection
Sheets("listing 2").Range("I2:I5000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'suppression des produit sans quantité
' création des page de commande
With Sheets("commande")
  .Unprotect  ' suppression de la protection
    For i = 8 To 35 Step 9
    .Range("F8:M16").Copy .Cells(i, "F")
    Application.CutCopyMode = False
    Next
    For i = 8 To 35 Step 9
    .Cells(i, "F").Resize(5, 8).Value = Sheets("listing 2").Range("F2:M6").Value
    Next
End With
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
256
robpellan52
R
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
F
  • Résolu(e)
Microsoft 365 Message Box oui/non
Réponses
2
Affichages
109
Francky79
F
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
324
gwenn49
G
X
  • Question
XL 2016 Copier à partir de la dernière ligne renseignée.
Réponses
8
Affichages
404
Xender
X
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
437
olivier388
O
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
363
fanou06
F
Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
302
Usine à gaz
Usine à gaz
Usine à gaz
  • Résolu(e)
XL 2021 Coller "RdV Fait Facturé" de "J" ligne active jusqu'à "J" dernière ligne NON vide
2
Réponses
27
Affichages
588
TooFatBoy
TooFatBoy
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
517
mouchtre
mouchtre

Membres actuellement en ligne

23 membres et 336 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 100
Messages
2 085 293
Membres
102 853
dernier inscrit
jetstream69