XL 2016 Nettoyage et extension macro

F

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
Bernard_XLD
Fat à dit:
Cette macro gérée par le bouton2 fonctionne
Cliquez pour agrandir...
Fat à dit:
lig = Sheets("CTS").Range("G" & Rows.Count).End(xlUp).Row + 1
Cliquez pour agrandir...
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" &...
Trier par date Trier par votes
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
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 !

@+
 
Vote positif 0 Vote négatif
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter 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 ]

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:
Vote positif 0 Vote négatif
F

Fat

XLDnaute Nouveau
Yeahou à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
Fat à dit:
La macro et le bouton2 sont dans la feuille SAI
Cliquez pour agrandir...
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:
Vote positif 0 Vote négatif
F

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: 11
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
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: 1
Dernière édition:
Vote positif 0 Vote négatif
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
Fat à dit:
Cette macro gérée par le bouton2 fonctionne
Cliquez pour agrandir...
Fat à dit:
lig = Sheets("CTS").Range("G" & Rows.Count).End(xlUp).Row + 1
Cliquez pour agrandir...
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: 4
Dernière édition:
Vote positif 0 Vote négatif
Solution

Discussions similaires

Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
piga25
  • Résolu(e)
XL 2016 Mettre la même couleur de la dernière cellule colorée
Réponses
5
Affichages
331
TooFatBoy
TooFatBoy
Nicolas JACQUIN
  • Question
XL 2019 Fusionner jusqu'à dernière colonne contenant
Réponses
8
Affichages
644
TooFatBoy
TooFatBoy
Nicolas JACQUIN
  • Question
XL 2021 Optimisation code pour affichage ligne et colonne
Réponses
14
Affichages
679
patricktoulon
patricktoulon
M
  • Question
Microsoft 365 Modifier code et format textbox
2 3
Réponses
35
Affichages
2 K
Marvin57
M
Amigo
  • Question
XL 2016 Protéger Plage avec condition
2
Réponses
16
Affichages
908
Amigo
Amigo
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
532
AtTheOne
AtTheOne
N
  • Question
Microsoft 365 Aide adaptation d'une macro
Réponses
2
Affichages
272
netparty
N
L
  • Résolu(e)
Microsoft 365 Suppression de cellules vide
Réponses
3
Affichages
419
Le Rouky
L
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
162
sebastien176
S

Membres actuellement en ligne

7 membres et 110 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
315 127
Messages
2 116 506
Membres
112 765
dernier inscrit
SIDIANW