Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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

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

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

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

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
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
  • Résolu(e)
XL 2016 Mettre la même couleur de la dernière cellule colorée
Réponses
5
Affichages
331
TooFatBoy
  • Question
XL 2019 Fusionner jusqu'à dernière colonne contenant
Réponses
8
Affichages
645
TooFatBoy
  • Question
XL 2021 Optimisation code pour affichage ligne et colonne
Réponses
14
Affichages
680
patricktoulon
M
  • Question
Microsoft 365 Modifier code et format textbox
2 3
Réponses
35
Affichages
2 K
Marvin57
M
  • Question
XL 2016 Protéger Plage avec condition
2
Réponses
16
Affichages
909
Amigo
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
535
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
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…