XL 2016 Nettoyage et extension macro

Fat

XLDnaute Nouveau
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
 
Solution
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 ]
VB:
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 =...
Bonjour Fat, le forum

VB:
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
Code:
lig = Range("G" & Rows.Count).End(xlUp).Row + 1
en codant un trableau, ça ira plus vite, je regarde !

@+
 
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 ]

Code:
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
 
Dernière édition:

Fat

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

Code:
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
 
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)]
Code:
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
 
Dernière édition:

Fat

XLDnaute Nouveau
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
 

Pièces jointes

  • Test Macro.xlsb
    24.5 KB · Affichages: 4

Phil69970

XLDnaute Accro
Bonjour à vous tous

@Fat je te propose ceci

VB:
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
 

Pièces jointes

  • Test Macro-V1.xlsm
    31.8 KB · Affichages: 0
Dernière édition:
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 ]
VB:
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
 

Pièces jointes

  • Test Macro - Copie.xlsb
    31.9 KB · Affichages: 3
Dernière édition:

Statistiques des forums

Discussions
288 664
Messages
1 893 836
Membres
170 101
dernier inscrit
Lupinps
Haut Bas