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

aide à la correction de macro

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion bpol
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
B

bpol

XLDnaute Impliqué
bonjour,

j'ai une macro que j'ai mdifiée mais elle ne veux pas fonctionner !!


Sub enregistrer()
'
' enregistrer Macro
' Macro enregistrée le 14/03/2008 par POLAIN
'
'Private Sub cmdEnregistrer_Click()
Dim lig As Long
Dim choixLig As Long
Dim col As Long
Dim choixCol As Long

' Trouver la ligne
choixLig = 0

For lig = 7 To 256
If Range("E7") = 0 Then choixLig = 7: Exit For

If Range("E" & lig) = Range("E1") Then choixLig = lig: Exit For

If Range("E" & lig) = 0 And Range("F3") > 1 Then
lig = Range("E65536").End(xlUp).Row + 1
Cells(lig, 5) = Range("E1")
choixLig = lig: Exit For
End If
Next lig

Cells(choixLig, 5) = Range("E1")

' If choixLig = 0 Then
' MsgBox "L'enregistrement n'est pas possible", vbCritical + vbOKOnly, "Erreur"
' Exit Sub
' End If

' Trouver la colonne
choixCol = 0
For col = 6 To 9
If Cells(choixLig, col) = 0 Then
choixCol = col
Exit For
End If
Next col

If choixCol = 0 Then
MsgBox "L'enregistrement n'est pas possible", vbCritical + vbOKOnly, "Erreur"
Exit Sub
End If

' Afficher le résultat
Cells(choixLig, choixCol).Value = Range("I1").Value

'and
Sheets("récap").Select
Ligne = Range("A65536").End(xlUp).Row + 1
Cells(Ligne, 1) = Sheets("tableau").Range("E1")
Cells(Ligne, 2) = Sheets("tableau").Range("H1")
Cells(Ligne, 3) = Sheets("tableau").Range("G1")
Cells(Ligne, 4) = Sheets("tableau").Range("I1")
'and
Workbooks("tempsmmss").Select
Ligne = Range("A65536").End(xlUp).Row + 1
Cells(Ligne, 1) = Sheets("tableau").Range("E1")
Cells(Ligne, 2) = Sheets("tableau").Range("I1")
Cells(Ligne, 3) = Sheets("tableau").Range("H1")
Cells(Ligne, 4) = Sheets("tableau").Range("G1")
'and
Workbooks("Prog2mmss_ok4.xls").Worksheets("tableau").Select
'And
ActiveWorkbook.save
'
End Sub


j'ai essayé plusieurs corrections sans résultats !!

merci Bpol
 
Trier par date Trier par votes
Re : aide à la correction de macro

Salut Bpol,

Dans l'état actuelle de la chose, difficile de t'aider 😕
A part supprimer les 2 lignes en jaune, qui doivent poser problème

Sinon joint nous le fichier et dis nous exactement ce que tu souhaiterais,
et ce que tu as pour le moment.

A+
 
Vote positif 0 Vote négatif
Re : aide à la correction de macro

Bonjour


Ton classeur contient plusieurs modules vides.

(Tu pourrais les supprimer, cela allègera ton fichier)

Si tu crées un fichier zip par fichier xls
tu pourras directement les joindre ici sur le forum


A+
 
Vote positif 0 Vote négatif
Re : aide à la correction de macro

Bonjour,

Essayez de voir si le code suivant apporte un progrès.
J'avoue ne pas très bien comprendre votre problème.

Code: 
Sub enregistrer_pmo()
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim lig As Long
Dim choixLig As Long
Dim col As Long
Dim choixCol As Long
Dim Ligne As Long
  
Set WB1 = ActiveWorkbook
Sheets("tableau").Activate   '????? est-ce bien cette feuille ?????
' Trouver la ligne
choixLig = 0
   
For lig = 7 To 256
 If Range("E7") = 0 Then choixLig = 7: Exit For

 If Range("E" & lig) = Range("E1") Then choixLig = lig: Exit For
 
 If Range("E" & lig) = 0 And Range("F3") > 1 Then
 lig = Range("E65536").End(xlUp).Row + 1
 Cells(lig, 5) = Range("E1")
 choixLig = lig: Exit For
 End If
Next lig
  
Cells(choixLig, 5) = Range("E1")

'    If choixLig = 0 Then
'        MsgBox "L'enregistrement n'est pas possible", vbCritical + vbOKOnly, "Erreur"
'        Exit Sub
'    End If
    
    ' Trouver la colonne
choixCol = 0
For col = 6 To 9
  If Cells(choixLig, col) = 0 Then
    choixCol = col
    Exit For
  End If
Next col
  
If choixCol = 0 Then
  MsgBox "L'enregistrement n'est pas possible", vbCritical + vbOKOnly, "Erreur"
  Exit Sub
End If
    
  ' Afficher le résultat
Cells(choixLig, choixCol).Value = Range("I1").Value
    
'and
Sheets("récap").Select
Ligne = Range("A65536").End(xlUp).Row + 1
Cells(Ligne, 1) = Sheets("tableau").Range("E1")
Cells(Ligne, 2) = Sheets("tableau").Range("H1")
Cells(Ligne, 3) = Sheets("tableau").Range("G1")
Cells(Ligne, 4) = Sheets("tableau").Range("I1")
    'and
Windows("tempsmmss.xls").Activate
Set WB2 = ActiveWorkbook

Ligne = Range("A65536").End(xlUp).Row + 1
Cells(Ligne, 1) = WB1.Sheets("tableau").Range("E1")
Cells(Ligne, 2) = WB1.Sheets("tableau").Range("H1")
Cells(Ligne, 3) = WB1.Sheets("tableau").Range("G1")
Cells(Ligne, 4) = WB1.Sheets("tableau").Range("I1")
    'and
Windows("Prog2mmss_ok4.xls").Activate
Worksheets("tableau").Select
'And
WB1.Save
WB2.Save
'
End Sub

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Résolu(e)
XL pour MAC Code vba pour recherche sur une seule ligne
Réponses
4
Affichages
191
deudecos
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
437
patricktoulon
N
  • Question Question
Microsoft 365 gestion de kilometrage
Réponses
4
Affichages
502
nabilexcel2007
N
  • Résolu(e)
XL 2021 Problème réaffectation variable Objet
Réponses
2
Affichages
260
treza88
F
  • Question Question
XL 2021 probleme dans la macro
Réponses
4
Affichages
743
kiki29
  • Question Question
XL 2021 Réduction temps d'exécution boucle macro
Réponses
11
Affichages
570
TooFatBoy
P
  • Question Question
XL 2010 Recopie de la date du jour jusqu'à la dernière ligne non vide
Réponses
5
Affichages
262
philmaure
P
X
  • Question Question
Microsoft 365 compte à rebours avec application.OnTime (Résolu)
Réponses
9
Affichages
365
xabino
X
M
  • Résolu(e)
Microsoft 365 Erreur inexplicable
Réponses
3
Affichages
241
Marie L
M
W
  • Résolu(e)
XL 2016 Placer mes photos dans la colonne A, [A3], [A4],etc, jusqu'en [A99] selon le prénom et le nom colonnes B et C
2
Réponses
29
Affichages
2 K
TooFatBoy
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
931
TooFatBoy
L
  • Résolu(e)
Microsoft 365 Erreur d'exécution 1004 : la méthode select de la classe Worksheet a échoué
Réponses
7
Affichages
300
LaurentVasseur
L
F
  • Question Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
764
Oneida
Y
  • Question Question
Microsoft 365 Cdbl et nombres à virgules
Réponses
4
Affichages
287
Valtrase
Y
  • Résolu(e)
Microsoft 365 Countifs et dates
2
Réponses
23
Affichages
796
youguybass
Y
  • Résolu(e)
XL 2019 colorer les différents aliments avec un code VB pour macro de ce genre ?
2
Réponses
16
Affichages
651
anthoYS
  • Résolu(e)
XL 2019 Adapter ce code, et améliorer le tableau avec graphique à l'année à y insérer ?
Réponses
4
Affichages
508
sylvanu
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
623
un internaute
U
A
  • Résolu(e)
XL 2019 Remplacer un mot et ajouter une couleur
Réponses
7
Affichages
614
Attila451
A
F
  • Question Question
Autres Listbox-transfère la recherche dans une ListBox vers une feuille de calcul
2
Réponses
18
Affichages
577
dysorthographie
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…