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

Macro condition SI trop volumineuse

Créer une discussion

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

Usine à gaz

XLDnaute Barbatruc
Bonjour,

J’ai deux problèmes que je ne sais pas résoudre et j’ai besoin de votre aide :

J’ai besoin de copier une colonne en fonction d’un numéro de semaine comme indiquée ci-dessous

If [ld1] = 1 Then (si ld1 = semaine 1 copie colonne I vers colonne B ) etc pour 53 semaines, soit 53 conditions)

1 – cela fait une macro très longues et peut-être auriez-vous une solution pour qu’elle soit plus courte ?
2 – Ld1 est dans une autre feuille (If [ld1] = 1 Then ) et je ne sais pas le traduire dans la macro.


Mini partie de la macro pour infos :

Sub CopieExped()
'
' CopieExped Macro
'

'
If [ld1] = 1 Then
Sheets("Exped").Select
ActiveSheet.Unprotect
Columns("I:I").Select
Selection.Copy
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3").Select
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Exit Sub
End If


If [ld1] = 2 Then
Sheets("Exped").Select
ActiveSheet.Unprotect
Columns("J:J").Select
Selection.Copy
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3").Select
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Exit Sub
End sub

En espèrant avoir été compréhensible, je vous adresse un grand merci pour vos réponses.
Amicalement,
Lionel,
 
Trier par date Trier par votes
Re : Macro condition SI trop volumineuse

Bonjour,

Hum ...

Essaye un truc du genre:

Code: 
    Dim i as integer
    For i = 1 to 53 step 1
        If cint(Worksheets("NomDeTaFeuille").Range("LD1").value) = i Then
            Sheets("Exped").Select
            ActiveSheet.Unprotect
            Columns(i+8).Select
            Selection.Copy
            Columns("B:B").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
            Range("A3").Select
            Application.CutCopyMode = False
            ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
            Exit For
        End If
    next i

Ca simplifie le code. En gros, tu fais une boucle qui détermine le numéro de semaine, tu le compares à ta valeur.
En principe, la colonne I a pour index 9, et la boucle commence à 1.
Donc i + 8 te donne la bonne colonne à copier.

Cordialement,
 
Vote positif 0 Vote négatif
Re : Macro condition SI trop volumineuse

Je viens de tester ta macro mais elle s'exécute en boucle (je pense jusqu'à 53), donc, elle ne s'arrête pas à la valeur de LD1

Ma cellule LD1 contenait la valeur 14 mais pas de copie de la colonne correspondante à cette valeur.

Dans la feuille "Exped", il y a 53 colonnes à copier sur "B" en fonction de la valeur de LDI :

I pour 1, J pour 2, K pour 3 etc....

Pas facile pour moi de faire ça LOL,
Encore merci de t'intéresser à mon soucis.
Amicalement,
Lionel,
 
Vote positif 0 Vote négatif
Re : Macro condition SI trop volumineuse

Re,

Copie ton code s'il te plait, j'ai du mal à voir pourquoi ça saute.

Peut-être un problème de format ou d'espace en trop ...

Essaye de remplacer cette ligne
Code: 
If cint(Worksheets("NomDeTaFeuille").Range("LD1").value) = i Then
par
Code: 
If cint(Trim(Worksheets("NomDeTaFeuille").Range("LD1").value)) = i Then
 
Vote positif 0 Vote négatif
Re : Macro condition SI trop volumineuse

Bonjour,

Si je comprends bien ton problème, tu as en case LD1 un numéro qui détermine une colonne, et tu souhaites qu'en colonne B s'affichent les valeurs de la colonne indiquées en LD1 (soit la colonne de numéro celui indiqué en LD1 +8)

Histoire de simplifier en évitant le VBA, colle ça en B1 et étends la sur toute la colonne

Code: 
=INDIRECT("L"&LIGNE(A1)&"C"&$LD$1+8;FAUX)
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro condition SI trop volumineuse

En fait
, je pense que je n'ai pas besoin de changer la ligne que tu m'indique car je suis déjà sur la feuille qui contient la valeur cellule LD1 et j'appel la macro "Call Sub CopieExped()) pendant l'exécution d'une autre macro.

Voici le code :

Sub CopieExped()
'
' CopieExped Macro
'

'
Dim i As Integer
For i = 1 To 53 Step 1
If [LD1] = 1 Then
Sheets("Exped").Select
ActiveSheet.Unprotect
Columns(i + 8).Select
Selection.Copy
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3").Select
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Exit For
End If
Next i

End Sub
 
Vote positif 0 Vote négatif
Re : Macro condition SI trop volumineuse

Re, bonjour Tirou,

Pigé.

Code: 
Sub CopieExped()
	'
	' CopieExped Macro
	'

	'
	Dim i As Integer
	For i = 1 To 53 Step 1
		'If [LD1] = 1 Then
		If cint(Worksheets("NomDeTaFeuille").Range("LD1").value) = i Then
			Sheets("Exped").Select
			ActiveSheet.Unprotect
			Columns(i + 8).Select
			Selection.Copy
			Columns("B:B").Select
			Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
			:=False, Transpose:=False
			Range("A3").Select
			Application.CutCopyMode = False
			ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
			Exit For
		End If
	Next i

End Sub

Dans ton code, tu ne changes pas la valeur de comparaison de LD1, du coup, il boucle jusqu'au bout, et ne copie rien.

Cordialement,
 
Vote positif 0 Vote négatif
Re : Macro condition SI trop volumineuse

Re,

Code: 
'If [LD1] = 1 Then     <== TA LIGNE QUI POSE PROBLEME (tu compares à chaque fois la valeur à 1)
If cint(Worksheets("NomDeTaFeuille").Range("LD1").value) = i Then     '<== LA CORRECTION QUI PREND EN COMPTE LA VARIABLE I

Essaye ça, et fais moi un retour s'il te plait, que je vois si ça bugue ou pas 🙂

Cordialement,
 
Vote positif 0 Vote négatif
Re : Macro condition SI trop volumineuse

J'ai fait :

Sub CopieExped()
'
' CopieExped Macro
'

'
Dim i As Integer
For i = 1 To 53 Step 1
If CInt(Worksheets("SM (2)").Range("LD1").Value) = i Then
Sheets("Exped").Select
ActiveSheet.Unprotect
Columns(i + 8).Select
Selection.Copy
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3").Select
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Exit For
End If
Next i

End Sub

ça beugue et bloque le fichier ... je le ferme avec le gestionnaire de tâches.
 
Vote positif 0 Vote négatif
Re : Macro condition SI trop volumineuse

Une boucle de 1 à 53 qui freeze ton Excel complètement ? 😵

Pose ton classeur en pièce jointe, que je vois ce qui se passe directement, parce que là ...

Cordialement,
 
Vote positif 0 Vote négatif
Re : Macro condition SI trop volumineuse

Petite correction de la formule proposée plus haut pour prendre en compte que la case LD1 est sur une autre feuille, la "SM (2)"

Code: 
=INDIRECT("L"&LIGNE(A1)&"C"&'SM (2)'!$LD$1+8;FAUX)

Et si il faut bien vérifier que la valeur est comprise entre 1 et 53 :
Code: 
=SI(ET('SM (2)'!$A$1>0;'SM (2)'!$A$1<54);INDIRECT("L"&LIGNE(A1)&"C"&'SM (2)'!$A$1+8;FAUX);"hors paramètre")


Toujours à coller en B1 et à étendre vers le bas
 
Dernière édition:
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

C
  • Résolu(e)
XL 2021 MsgBox : Je ne sais pas faire...
Réponses
10
Affichages
184
Constantin
C
J
  • Résolu(e)
Microsoft 365 Collage valeur Erreur d'exécution 1004
Réponses
7
Affichages
216
Magic_Doctor
  • Question Question
XL 2016 compilation macro on/off
Réponses
7
Affichages
174
job75
C
  • Question Question
XL 2021 Exporter des données vers une autre feuille...
Réponses
7
Affichages
196
sylvanu
J
  • Résolu(e)
Microsoft 365 Première cellule vide ou égal zéros dans une plage définie
Réponses
11
Affichages
455
juju91
J
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
1 K
Phil69970
  • Résolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
645
AtTheOne
  • Résolu(e)
XL 2019 Renvoyé à la ligne suivante si la ligne demandé n'est pas libre
Réponses
9
Affichages
343
Phil69970
F
Fdaga
Réponses
2
Affichages
135
dysorthographie
  • Question Question
XL 2016 copier valeur actuel
2
Réponses
18
Affichages
597
sylvanu
C
  • Résolu(e)
XL 2021 Reporter la valeur d'une cellule dans le pied de page.
2
Réponses
17
Affichages
294
sylvanu
J
  • Résolu(e)
Microsoft 365 Valeur cellule dans un macro
2
Réponses
17
Affichages
677
job75
N
  • Résolu(e)
Microsoft 365 Macro entre 2 classeurs
2
Réponses
19
Affichages
761
Nounours4173
N
  • Résolu(e)
XL 2016 macro fichier fermé
Réponses
1
Affichages
191
eastwick
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
791
ph.vanne
  • Question Question
XL 2016 intégrer une macro sur les nouvelles feuilles crées
Réponses
6
Affichages
230
pascal21
M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
1 K
MICHAEL
M
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
617
un internaute
U
C
  • Question Question
Microsoft 365 Enregistrer via VBA sans ouvrir fichier
Réponses
9
Affichages
538
cdric78
C
F
Fdaga
Réponses
0
Affichages
190
Fdaga
F
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…