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

Macro sans fin

Z

Zepioutas

XLDnaute Nouveau
Bonjour à tous,

Je dois avoir un pb avec la macro suivante que je n'arrive pas à identifier, tout se passe bien jusqu'à la fin mais impossible d'enchaîner :

- Si j'ajoute un "glut" en fin de macro pour vérifier qu'elle s'est correctement finie, le test est négatif (ici exemple = sélectionner A1)
- Si j'apl la macro et que j'en apl une autre successivement, la nouvelle macro s'arrête à la macro "Apl_besoin"

La macro en question :

Sub Apl_Besoin()
'
' Apl_Besoin Macro

'
Application.Goto Reference:="Besoins_Exprimés"
Selection.Copy
Sheets("feuil2").Select
Range("A1").Select
ActiveSheet.Paste

nb = 24
For f = 3 To nb
Columns(2 * f).Insert
Next

Dim Li As Long
Dim i As Byte

i = Range("IV1").End(xlToLeft).Column

For Li = 2 To i

Cells(1, 2 * Li + 1).Select
If Cells(1, 2 * Li + 1) = "" Then
End
End If

If Cells(1, 2 * Li + 1) <> "" Then
Selection.Copy
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

ActiveCell.Select
ActiveCell.Replace What:="Besoin", Replacement:="Affecté", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False

End If
Next

Range("A1").Select

End Sub

Merci d'avance à tous !
 
Dernière modification par un modérateur:
Trier par date Trier par votes
Z

Zepioutas

XLDnaute Nouveau
Re : Macro sans fin

NB pour info : La macro permet d'insérer une colonne toute les 2 colonnes (1 colonne sur 2) et d'indiquer le titre de la colonne insérée (= le titre de la colonne de gauche avec remplacement de "Besoin" par "Affectation").
 
Vote positif 0 Vote négatif
Z

Zepioutas

XLDnaute Nouveau
Re : Macro sans fin

Bonjour suistrop et autre forum contributor

Voici un fichier d'exemple.

Il était trop lourd donc j'ai enlevé les macros, que vous retrouverez si dessous.
La macro qui Call "Apl_Besoin" est "Reporting_projet".

Merci d'avance.

Sub Reporting_projets()

Call Apl_Besoin

Call Apl_Affectations


End Sub



Sub Apl_Besoin()
'
' Apl_Besoin Macro
'
'

'
Range("B86:AE115").Select
Selection.Copy
Sheets("feuil2").Select
Range("A1").Select
ActiveSheet.Paste

nb = 24
For f = 3 To nb
Columns(2 * f).Insert
Next



Dim Li As Long
Dim i As Byte

i = Range("IV1").End(xlToLeft).Column

For Li = 2 To i

Cells(1, 2 * Li + 1).Select
If Cells(1, 2 * Li + 1) = "" Then
End
End If


If Cells(1, 2 * Li + 1) <> "" Then
Selection.Copy
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

ActiveCell.Select
ActiveCell.Replace What:="Besoin", Replacement:="Affecté", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False

End If
Next

Range("A1").Select


End Sub

Sub Apl_Affectations()

'
' Apl_Besoin Macro
' Macro enregistrée le 04/03/2009 par EDF-GDF

Range("B2").Select


End Sub
 

Pièces jointes

  • Exemple2.xls
    48 KB · Affichages: 51
  • Exemple2.xls
    48 KB · Affichages: 54
  • Exemple2.xls
    48 KB · Affichages: 52
Dernière modification par un modérateur:
Vote positif 0 Vote négatif

suistrop

XLDnaute Impliqué
Re : Macro sans fin

salut, essai avec ca

Code: 
Sub Apl_Besoin()
'
' Apl_Besoin Macro
 
'
 
'
Sheets("BDD").Select
Range("B86:AE115").Select
Selection.Copy
Sheets("feuil2").Select
Range("A1").Select
ActiveSheet.Paste
 
nb = 24
For f = 3 To nb
    Columns(2 * f).Insert
Next f
 
 
 
Dim Li As Long
Dim i As Byte
 
i = Range("IV1").End(xlToLeft).Column
 
For Li = 2 To i
 
    Cells(1, 2 * Li + 1).Select
    If Cells(1, 2 * Li + 1) = "" Then
        'on fais rien
    ElseIf Cells(1, 2 * Li + 1) <> "" Then
        Selection.Copy
        ActiveCell.Offset(0, 1).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
 
        ActiveCell.Select
        ActiveCell.Replace What:="Besoin", Replacement:="Affecté", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False
 
    End If
Next Li
 
Range("A1").Select
 
 
End Sub
tu avais des truc chelou dans ta partie if .... un End qui trainais seul....
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Z

Zepioutas

XLDnaute Nouveau
Re : Macro sans fin

Merci suistrop, ça le fait bien (Il faut donc ajouter la variable après le next...)

Pour le End en trop, je ne pensais pas qu'en indiquant rien du tout, il ne se passerait rien


Bravo et see you forum
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
Microsoft 365 L'indice n'appartient pas à la sélection
Réponses
8
Affichages
389
TooFatBoy
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
300
Compte Supprimé 979
C
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
321
robpellan52
R
Y
  • Question
Microsoft 365 Insérer des lignes selon variable
Réponses
1
Affichages
276
gbinforme
G
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
162
marie3107
M
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
187
rebatte
R
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
212
marie3107
M
P
  • Question
Microsoft 365 Macro qui plante exel
Réponses
1
Affichages
276
mapomme
D
  • Question
XL 2010 Valoriser cellule par clic
Réponses
4
Affichages
292
fanch55
  • Question
Microsoft 365 Format Nombre Combobox dans Feuille
Réponses
3
Affichages
233
fanch55
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…