XL 2016 Nettoyage et extension macro

[Fat]

Bonsoir Le Forum,

- Cette macro gérée par le bouton2 fonctionne (message d'alerte si manque info et déplacement de lignes de feuille SAI vers feuille CTS) mais avec lenteur.
Le résultat n'est obtenu qu'après 3 à 4 secondes après validation.
Peut-on l'alléger ou mieux la réécrire ?
- Je souhaiterais aussi qu'elle puisse m'effacer la cellule H5
Que dois-je faire ? comment et à quel endroit ?
Merci pour votre assistance
Cordialement
Fat

Private Sub CommandButton2_Click() 'valider
If Range("A11").Value = "" Then
MsgBox "Manque ETAT de la Saisie", vbCritical, "ATTENTION"
Exit Sub
Else
End If

Dim lig As Long, col As Integer, x As Integer
lig = Sheets("CTS").Range("G" & Rows.Count).End(xlUp).Row + 1
' If Sheets("CTS").Range("TableauCTS").Item(7, 1) <> "" Then lig = Sheets("CTS").Range("TableauCTS").Rows.Count + 1 Else lig = 1
x = 11
Do While True
For col = 1 To 22
Sheets("CTS").Cells(lig, col).Value = Sheets("SAI").Cells(x, col).Value
Next
x = x + 1
If Len(Sheets("SAI").Cells(x, 7).Value) = 0 Then Exit Do
lig = lig + 1
Loop
Sheets("SAI").Range("G12:V999").ClearContents

End Sub

 

[Bernard_XLD]

Bonjour Fat, le forum

lig = Sheets("CTS").Range("G" & Rows.Count).End(xlUp).Row + 1

en première lecture, bug si ton bouton n'est pas dans la feuille CTS car ton rows.count se réfère à la feuille active.
et si il l'est, pas besoin de préciser la feuille

lig = Range("G" & Rows.Count).End(xlUp).Row + 1

en codant un trableau, ça ira plus vite, je regarde !

@+

 

[Staple1600]

Bonsoir le fil

[aparté]
Parfois il faut pas aller trop vite 😉

en codant un trableau, ça ira plus vite, je regarde !

Pardon, j'ai pas pu m'empêcher (encore)
😉

 

[Phil69970]

Bonjour à tous

Je suis même étonné que Staple n'ait pas dit :

Tu as de trableau yeux .... 😉

Pardon, j'ai pas pu m'empêcher

J'aurais pas dit mieux 🙃

C'était la minute humour d'un mercredi soir confiné ....

Spoiler

Sors de ce corps Staple🙄

@Phil69970

 

[Bernard_XLD]

re,
pas de fichier pour tester (et ce n'est pas à moi de le créer) mais cela devrait le faire un peu plus rapidement et sans tableau [ et avec un code un peu plus court ]

Private Sub CommandButton2_Click() 'valider
If Range("A11").Value = "" Then
    MsgBox "Manque ETAT de la Saisie", vbCritical, "ATTENTION"
    Exit Sub
End If

Dim lig As Long
Application.Calculation = xlCalculationManual
lig = Range("G" & Rows.Count).End(xlUp).Row + 1
With Sheets("SAI")
    Range("A" & lig & ":V" & lig + .Range("G" & .Rows.Count).End(xlUp).Row - 11).Value = .Range("A11:V" & .Range("G" & .Rows.Count).End(xlUp).Row).Value
    .Range("G12:V999").ClearContents
End With
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Bernard_XLD]

aparté

ben vas y alors ! [désolé!]

 

[Staple1600]

Re

>Yeahou
Désolé je n'ai pas compris.
Ce n'était qu'un trait d'humour.
Vexé?

 

[Bernard_XLD]

moi aussi je fais de l'humour vaseux, aparté = "ah, partais !"
re désolé ! 🤣 🤣 🤣 😇

 

[Fat]

re,
pas de fichier pour tester mais cela devrait le faire un peu plus rapidement et sans tableau

Sub test()
If Range("A11").Value = "" Then
    MsgBox "Manque ETAT de la Saisie", vbCritical, "ATTENTION"
    Exit Sub
End If

Dim lig As Long
Application.Calculation = xlCalculationManual
lig = Range("G" & Rows.Count).End(xlUp).Row + 1
With Sheets("SAI")
    Range("A" & lig & ":V" & lig + .Range("G" & .Rows.Count).End(xlUp).Row - 11).Value = .Range("A11:V" & .Range("G" & .Rows.Count).End(xlUp).Row).Value
    .Range("G12:V999").ClearContents
End With
Application.Calculation = xlCalculationAutomatic
End Sub

Bonsoir l’ambiance !
La macro et le bouton2 sont dans la feuille SAI pour déplacer des lignes vers la feuille CTS.
- Et quoi faire pour effacer la cellule H5 de la feuille SAI ?
J’aime bien votre bonne humeur.
Passez une bonne soirée.
Cordialement
Fat

 

[Bernard_XLD]

- Je souhaiterais aussi qu'elle puisse m'effacer la cellule H5

j'ai oublié cela, si c'est sur la feuille CTS, ajoutes à la fin du code

[H5].Clearcontents

 

[Bernard_XLD]

La macro et le bouton2 sont dans la feuille SAI

ben ça change tout, voila le code modifié en ce sens mais pas testé (d'où l'intérêt d'un fichier test)
[en fait j'utilise quand même un tableau (de range)]

Private Sub CommandButton2_Click() 'valider
If Range("A11").Value = "" Then
    MsgBox "Manque ETAT de la Saisie", vbCritical, "ATTENTION"
    Exit Sub
End If

Dim lig As Long
Application.Calculation = xlCalculationManual
lig = Sheets("CTS").Range("G" & Sheets("CTS").Rows.Count).End(xlUp).Row + 1
Sheets("CTS").Range("A" & lig & ":V" & lig + Range("G" & Rows.Count).End(xlUp).Row - 11).Value = Range("A11:V" & Range("G" & .Rows.Count).End(xlUp).Row).Value
Range("G12:V999").ClearContents
Application.Calculation = xlCalculationAutomatic
[H5].ClearContents
End Sub

 

[Bernard_XLD]

J’aime bien votre bonne humeur.

pour citer Coluche, c'est pas parce qu'on ne paye pas et qu'on est pas payé qu'on doit se faire ch... !

 

[Fat]

Bonsoir Le Forum, Bonsoir Yeahou et Staple,
Merci pour vos propositions, mais elles ne marchent pas.
Ci joint un fichier pour mieux illustrer mon problème.
Cordialement
Fat

 

[Phil69970]

Bonjour à vous tous

@Fat je te propose ceci

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim DerligSrc&, DerligDest&

With Worksheets("SAI")
    DerligSrc = .Range("P" & Rows.Count).End(xlUp).Row
    DerligDest = Worksheets("CTS").Range("P" & Rows.Count).End(xlUp).Row + 1

    .Range("A11:P" & DerligSrc).Copy Worksheets("CTS").Range("A" & DerligDest)
    .Range("F12:P" & DerligSrc).ClearContents
    .Range("H8").Select
End With
Application.CutCopyMode = False

End Sub

*Le fichier suit ....

Je n'ai pas le pack XLP

@Phil69970

 

[Bernard_XLD]

Cette macro gérée par le bouton2 fonctionne

lig = Sheets("CTS").Range("G" & Rows.Count).End(xlUp).Row + 1

il faudrait m'expliquer comment cette macro du post 1 a pu fonctionner avec une colonne G entièrement vide ! 😡
avec le fichier, ça va mieux ! même le bouton n'est pas le même, 2 dans le post 1, 1 dans le fichier

[édition: salut @Phil69970 ]

Private Sub CommandButton1_Click() 'valider
If Range("A11").Value = "" Then
    MsgBox "Manque ETAT de la Saisie", vbCritical, "ATTENTION"
    Exit Sub
End If

Dim lig As Long
Application.Calculation = xlCalculationManual
With Sheets("CTS")
    lig = .Range("H" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & lig & ":V" & lig + Range("H" & Rows.Count).End(xlUp).Row - 11).Value _
        = Range("A11:V" & Range("H" & Rows.Count).End(xlUp).Row).Value
End With
Range("G12:V999,H5").ClearContents
Application.Calculation = xlCalculationAutomatic
End Sub