VBA - Procédure trod grande?

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Mouchty85
  • 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
M

Mouchty85

XLDnaute Occasionnel
Bonsoir à tous,
Je suis en train de faire un petit programme sur excel avec visual basic, et je me trouve face à un problème que je ne sais pas résoudre.

J'ai un userfrom dans lequel il y a une liste déroulant ou je selectionne un des 40 projets
quand j'appuis sur le bouton d'action, les informations entrér dans l'userfrom sont mise dans un tableau excel.
Mon problème bien de l'éxécution de la macro.
elle se déroule ainsi

IF la valeur de ma Combox est égale a la cellule A1 de La feuille Projet 1 THEN
Selection du tableau
Insertion d'un ligne
Remplissage des cellule
END IF

IF la valeur de ma Combox est égale a la cellule A1 de La feuille Projet 2 THEN
Selection du tableau
Insertion d'un ligne
Remplissage des cellule
END IF

...

et cela 40 fois

VBA me dit que la procédure est trop grande alors pourriez vouis m'aider a résoudre ce^problème

Je vouremercie d'avance.

Mouchty85
 
Trier par date Trier par votes
Re : VBA - Procédure trod grande?

Salut Mouchty85,

Le plus simple serais de voir un exemple de ton fichier et ton code en entier, mais je dirais qu'en bouclant sur les feuilles de ton classeur et en mettant leur nom dans un tablo si elles correspondent a ton critère, il suffirait de boucler ensuite sur le tablo pour faire ce que tu veux.

Facile a dire mais reste a savoir si je serais capable d'y arriver tout seul, je ne maitrise pas encore les tablo comme Maître Hervé.

Met nous un exemple de ton fichier (seulement quelques lignes et 5 ou 6 onglets) devrait suffir. Laisse egalement ton code,

@+
 
Vote positif 0 Vote négatif
Re : VBA - Procédure trod grande?

Voila mon code je peux pas faire mieu comme information.
Merci pour ton aide






For i = 1 To Sheets.Count
Sheets(i).Visible = True
ActiveSheet.Unprotect
Next i

'Projet 1
Sheets("P1").Select

If PA_P_Projet.Value = Range("A1").Value Then

NL = Range("P_1").Rows.Count
Range("P_1").Cells(NombresLignes, 1).EntireRow.Select
Selection.Insert Shift:=xlDown

Range("P_1").Cells(NL - 1, 1).Value = PA_P_Date.Value
Range("P_1").Cells(NL - 1, 2).Value = PA_P_Réf.Value
Range("P_1").Cells(NL - 1, 3).Value = Range("P__Calcul").Cells(1, 2).Value
Range("P_1").Cells(NL - 1, 4).Value = Range("P__Calcul").Cells(1, 3).Value
Range("P_1").Cells(NL - 1, 5).Value = PA_P_Qtté.Value
Range("P_1").Cells(NL - 1, 6).Value = Range("P__Calcul").Cells(1, 5).Value
Range("P_1").Cells(NL - 1, 7).Value = PA_P_Encaissement.Value
Range("P_1").Cells(NL - 1, 8).Value = PA_P_Dépense.Value
Range("P_1").Cells(NL - 1, 9).Value = PA_P_Recette.Value
Range("P_1").Cells(NL - 1, 10).Value = PA_P_Membre.Value

End If

'Projet 2
Sheets("P2").Select

If PA_P_Projet.Value = Range("A1").Value Then

NL = Range("P_2").Rows.Count
Range("P_2").Cells(NombresLignes, 1).EntireRow.Select
Selection.Insert Shift:=xlDown

Range("P_2").Cells(NL - 1, 1).Value = PA_P_Date.Value
Range("P_2").Cells(NL - 1, 2).Value = PA_P_Réf.Value
Range("P_2").Cells(NL - 1, 3).Value = Range("P__Calcul").Cells(1, 2).Value
Range("P_2").Cells(NL - 1, 4).Value = Range("P__Calcul").Cells(1, 3).Value
Range("P_2").Cells(NL - 1, 5).Value = PA_P_Qtté.Value
Range("P_2").Cells(NL - 1, 6).Value = Range("P__Calcul").Cells(1, 5).Value
Range("P_2").Cells(NL - 1, 7).Value = PA_P_Encaissement.Value
Range("P_2").Cells(NL - 1, 8).Value = PA_P_Dépense.Value
Range("P_2").Cells(NL - 1, 9).Value = PA_P_Recette.Value
Range("P_2").Cells(NL - 1, 10).Value = PA_P_Membre.Value

End If

'Projet 3
Sheets("P3").Select

If PA_P_Projet.Value = Range("A1").Value Then

NL = Range("P_3").Rows.Count
Range("P_3").Cells(NombresLignes, 1).EntireRow.Select
Selection.Insert Shift:=xlDown

Range("P_3").Cells(NL - 1, 1).Value = PA_P_Date.Value
Range("P_3").Cells(NL - 1, 2).Value = PA_P_Réf.Value
Range("P_3").Cells(NL - 1, 3).Value = Range("P__Calcul").Cells(1, 2).Value
Range("P_3").Cells(NL - 1, 4).Value = Range("P__Calcul").Cells(1, 3).Value
Range("P_3").Cells(NL - 1, 5).Value = PA_P_Qtté.Value
Range("P_3").Cells(NL - 1, 6).Value = Range("P__Calcul").Cells(1, 5).Value
Range("P_3").Cells(NL - 1, 7).Value = PA_P_Encaissement.Value
Range("P_3").Cells(NL - 1, 8).Value = PA_P_Dépense.Value
Range("P_3").Cells(NL - 1, 9).Value = PA_P_Recette.Value
Range("P_3").Cells(NL - 1, 10).Value = PA_P_Membre.Value

End If

'Projet 4
Sheets("P4").Select

If PA_P_Projet.Value = Range("A1").Value Then

NL = Range("P_4").Rows.Count
Range("P_4").Cells(NombresLignes, 1).EntireRow.Select
Selection.Insert Shift:=xlDown

Range("P_4").Cells(NL - 1, 1).Value = PA_P_Date.Value
Range("P_4").Cells(NL - 1, 2).Value = PA_P_Réf.Value
Range("P_4").Cells(NL - 1, 3).Value = Range("P__Calcul").Cells(1, 2).Value
Range("P_4").Cells(NL - 1, 4).Value = Range("P__Calcul").Cells(1, 3).Value
Range("P_4").Cells(NL - 1, 5).Value = PA_P_Qtté.Value
Range("P_4").Cells(NL - 1, 6).Value = Range("P__Calcul").Cells(1, 5).Value
Range("P_4").Cells(NL - 1, 7).Value = PA_P_Encaissement.Value
Range("P_4").Cells(NL - 1, 8).Value = PA_P_Dépense.Value
Range("P_4").Cells(NL - 1, 9).Value = PA_P_Recette.Value
Range("P_4").Cells(NL - 1, 10).Value = PA_P_Membre.Value

End If

'Projet 5
Sheets("P5").Select

If PA_P_Projet.Value = Range("A1").Value Then

NL = Range("P_5").Rows.Count
Range("P_5").Cells(NombresLignes, 1).EntireRow.Select
Selection.Insert Shift:=xlDown

Range("P_5").Cells(NL - 1, 1).Value = PA_P_Date.Value
Range("P_5").Cells(NL - 1, 2).Value = PA_P_Réf.Value
Range("P_5").Cells(NL - 1, 3).Value = Range("P__Calcul").Cells(1, 2).Value
Range("P_5").Cells(NL - 1, 4).Value = Range("P__Calcul").Cells(1, 3).Value
Range("P_5").Cells(NL - 1, 5).Value = PA_P_Qtté.Value
Range("P_5").Cells(NL - 1, 6).Value = Range("P__Calcul").Cells(1, 5).Value
Range("P_5").Cells(NL - 1, 7).Value = PA_P_Encaissement.Value
Range("P_5").Cells(NL - 1, 8).Value = PA_P_Dépense.Value
Range("P_5").Cells(NL - 1, 9).Value = PA_P_Recette.Value
Range("P_5").Cells(NL - 1, 10).Value = PA_P_Membre.Value

End If

'Projet 6
Sheets("P6").Select

If PA_P_Projet.Value = Range("A1").Value Then

NL = Range("P_6").Rows.Count
Range("P_6").Cells(NombresLignes, 1).EntireRow.Select
Selection.Insert Shift:=xlDown

Range("P_6").Cells(NL - 1, 1).Value = PA_P_Date.Value
Range("P_6").Cells(NL - 1, 2).Value = PA_P_Réf.Value
Range("P_6").Cells(NL - 1, 3).Value = Range("P__Calcul").Cells(1, 2).Value
Range("P_6").Cells(NL - 1, 4).Value = Range("P__Calcul").Cells(1, 3).Value
Range("P_6").Cells(NL - 1, 5).Value = PA_P_Qtté.Value
Range("P_6").Cells(NL - 1, 6).Value = Range("P__Calcul").Cells(1, 5).Value
Range("P_6").Cells(NL - 1, 7).Value = PA_P_Encaissement.Value
Range("P_6").Cells(NL - 1, 8).Value = PA_P_Dépense.Value
Range("P_6").Cells(NL - 1, 9).Value = PA_P_Recette.Value
Range("P_6").Cells(NL - 1, 10).Value = PA_P_Membre.Value

End If

'Projet 7
Sheets("P7").Select

If PA_P_Projet.Value = Range("A1").Value Then

NL = Range("P_7").Rows.Count
Range("P_7").Cells(NombresLignes, 1).EntireRow.Select
Selection.Insert Shift:=xlDown

Range("P_7").Cells(NL - 1, 1).Value = PA_P_Date.Value
Range("P_7").Cells(NL - 1, 2).Value = PA_P_Réf.Value
Range("P_7").Cells(NL - 1, 3).Value = Range("P__Calcul").Cells(1, 2).Value
Range("P_7").Cells(NL - 1, 4).Value = Range("P__Calcul").Cells(1, 3).Value
Range("P_7").Cells(NL - 1, 5).Value = PA_P_Qtté.Value
Range("P_7").Cells(NL - 1, 6).Value = Range("P__Calcul").Cells(1, 5).Value
Range("P_7").Cells(NL - 1, 7).Value = PA_P_Encaissement.Value
Range("P_7").Cells(NL - 1, 8).Value = PA_P_Dépense.Value
Range("P_7").Cells(NL - 1, 9).Value = PA_P_Recette.Value
Range("P_7").Cells(NL - 1, 10).Value = PA_P_Membre.Value

End If

'Projet 8
Sheets("P8").Select

If PA_P_Projet.Value = Range("A1").Value Then

NL = Range("P_8").Rows.Count
Range("P_8").Cells(NombresLignes, 1).EntireRow.Select
Selection.Insert Shift:=xlDown

Range("P_8").Cells(NL - 1, 1).Value = PA_P_Date.Value
Range("P_8").Cells(NL - 1, 2).Value = PA_P_Réf.Value
Range("P_8").Cells(NL - 1, 3).Value = Range("P__Calcul").Cells(1, 2).Value
Range("P_8").Cells(NL - 1, 4).Value = Range("P__Calcul").Cells(1, 3).Value
Range("P_8").Cells(NL - 1, 5).Value = PA_P_Qtté.Value
Range("P_8").Cells(NL - 1, 6).Value = Range("P__Calcul").Cells(1, 5).Value
Range("P_8").Cells(NL - 1, 7).Value = PA_P_Encaissement.Value
Range("P_8").Cells(NL - 1, 8).Value = PA_P_Dépense.Value
Range("P_8").Cells(NL - 1, 9).Value = PA_P_Recette.Value
Range("P_8").Cells(NL - 1, 10).Value = PA_P_Membre.Value

End If

'Projet 9
Sheets("P9").Select

If PA_P_Projet.Value = Range("A1").Value Then

NL = Range("P_9").Rows.Count
Range("P_9").Cells(NombresLignes, 1).EntireRow.Select
Selection.Insert Shift:=xlDown

Range("P_9").Cells(NL - 1, 1).Value = PA_P_Date.Value
Range("P_9").Cells(NL - 1, 2).Value = PA_P_Réf.Value
Range("P_9").Cells(NL - 1, 3).Value = Range("P__Calcul").Cells(1, 2).Value
Range("P_9").Cells(NL - 1, 4).Value = Range("P__Calcul").Cells(1, 3).Value
Range("P_9").Cells(NL - 1, 5).Value = PA_P_Qtté.Value
Range("P_9").Cells(NL - 1, 6).Value = Range("P__Calcul").Cells(1, 5).Value
Range("P_9").Cells(NL - 1, 7).Value = PA_P_Encaissement.Value
Range("P_9").Cells(NL - 1, 8).Value = PA_P_Dépense.Value
Range("P_9").Cells(NL - 1, 9).Value = PA_P_Recette.Value
Range("P_9").Cells(NL - 1, 10).Value = PA_P_Membre.Value

End If




PA_P_Membre.Value = ""
PA_P_Date.Value = ""
PA_P_Réf.Value = ""
PA_P_Qtté.Value = ""
PA_P_Encaissement.Value = ""
PA_P_Recette.Value = ""
PA_P_Dépense.Value = ""

'For j = 2 To Sheets.Count
'Sheets(j).Visible = False
'Next j

'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
 
Vote positif 0 Vote négatif
Re : VBA - Procédure trod grande?

re,

J'avais peut etre vu un peu compliqué, je te propose le code suivant, mais comme je n'es pas ton classeur sous les yeux, il y aura peut etre quelques modif a faire. Par exemple, la macro risque de planter si toutes tes feuilles ne sont pas du type Pquelque_chose (quelque_chose etant un nombre).

De plus, tu verras a la fin du code, j'ai mis une partie en commentaires car je ne sais pas trop a quoi servait ce bout de code.

PHP: 
Sub test()
Dim i%, k%
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
    Sheets(i).Visible = True
    ActiveSheet.Unprotect
    Sheets("P" & i).Select
    If PA_P_Projet.Value = Range("A1").Value Then
        NL = Range("P_" & i).Rows.Count
        Range("P_" & i).Cells(NombresLignes, 1).EntireRow.Select
        Selection.Insert Shift:=xlDown
        For k = 1 To 10
            Range("P_" & i).Cells(NL - 1, 1).Value = PA_P_Date.Value
            Range("P_" & i).Cells(NL - 1, 2).Value = PA_P_Réf.Value
            Range("P_" & i).Cells(NL - 1, 3).Value = Range("P__Calcul").Cells(1, 2).Value
            Range("P_" & i).Cells(NL - 1, 4).Value = Range("P__Calcul").Cells(1, 3).Value
            Range("P_" & i).Cells(NL - 1, 5).Value = PA_P_Qtté.Value
            Range("P_" & i).Cells(NL - 1, 6).Value = Range("P__Calcul").Cells(1, 5).Value
            Range("P_" & i).Cells(NL - 1, 7).Value = PA_P_Encaissement.Value
            Range("P_" & i).Cells(NL - 1, 8).Value = PA_P_Dépense.Value
            Range("P_" & i).Cells(NL - 1, 9).Value = PA_P_Recette.Value
            Range("P_" & i).Cells(NL - 1, 10).Value = PA_P_Membre.Value
        Next k
    End If
Next i
Application.ScreenUpdating = True
'ca je sais pas trop a quoi ca sert vu ou c'est placé
'PA_P_Membre.Value = ""
'PA_P_Date.Value = ""
'PA_P_Réf.Value = ""
'PA_P_Qtté.Value = ""
'PA_P_Encaissement.Value = ""
'PA_P_Recette.Value = ""
'PA_P_Dépense.Value = ""
End Sub

C'est fait a vue de nez puisque je n'ai pas le moyen de tester, donc je te laisse le soin de regarder et de me dire ce que tu en penses.

@+
 
Vote positif 0 Vote négatif
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

Lu76Fer
XLS : Evènements souris 'click' sur la grille & astuces
Réponses
3
Affichages
171
Lu76Fer
Lu76Fer
S
  • Question Question
XL 2019 Problème dans un code vba
Réponses
2
Affichages
593
snoopy07
S
L
  • Question Question
XL 2019 Excel - utilisation des unbound pour grande base de donnees
Réponses
11
Affichages
920
Lordpeter
L
H
  • Question Question
Microsoft 365 Besoin aide : Erreur code macro . Problème est résolu
Réponses
7
Affichages
948
heart clean
H
G
  • Résolu(e)
Microsoft 365 Erreur VBA
Réponses
2
Affichages
301
Grododos
G
M
  • Résolu(e)
XL 2016 Filtre auto VBA
Réponses
3
Affichages
897
MickaeL_D
M
M
  • Résolu(e)
Microsoft 365 VBA - RECHERCHEV multiples dans un autre classeur sélectionné
Réponses
1
Affichages
726
M4x1m3
M
T
  • Question Question
XL 2019 VBA: Effacer le contenu de plages de cellules avec critères
Réponses
5
Affichages
2 K
tiitii60
T
S
  • Question Question
XL 2016 VBA PI DataLink : Probleme Application.Screenupdating avec procédure de MAJ plage
2
Réponses
19
Affichages
3 K
safranien
S
L
  • Question Question
XL 2019 code de destockage
Réponses
4
Affichages
1 K
Lune999
L
T
  • Question Question
XL 2016 [VBA] problème macro EXCEL ne réponds pas
Réponses
11
Affichages
2 K
terry08200
T
L
  • Résolu(e)
XL 2016 Lien hypertexte VBA
Réponses
1
Affichages
1 K
Louu59
L
L
  • Question Question
XL 2019 Besoins d'aide pour corriger une macro qui ne fonctionne pas - svp
Réponses
2
Affichages
900
ThierryP
T
S
  • Résolu(e)
XL 2019 code vba changement de couleur si modification de la cellule
Réponses
7
Affichages
2 K
syriak
S
G
  • Question Question
XL 2016 Ecrire une boucle pour afficher ensemble dans un userform, toutes ses textbox complétées par la boucle! Voir mon code et photos feuilles joints !
Réponses
8
Affichages
978
vgendron
vgendron
M
  • Question Question
Microsoft 365 Programme trop lent
Réponses
12
Affichages
978
Hasco
Hasco
D
  • Question Question
XL 2010 Création et mise à jour d'un TCD tableau croisé dynamique avec macro VBA
Réponses
1
Affichages
3 K
chris
chris
V
  • Résolu(e)
Microsoft 365 Afficher filtres appliqués par macro dans la cellule B3 directement et non par F5 puis Réinitialiser
Réponses
12
Affichages
1 K
VirginieG
V
T
  • Résolu(e)
Microsoft 365 Copier coller la valeur d'une cellule Excel
Réponses
2
Affichages
874
ThomasBRD
T
N
  • Résolu(e)
Gérer Active.document de Word depuis Excel
Réponses
3
Affichages
2 K
n.excel
N
Retour