Microsoft 365 Erreur d'exécution '91'

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 !

SAAD doli

XLDnaute Nouveau
Bonjour tout le monde , j'espère que vous allez bien
j'ai un problème qui s'affiche quand je lance cette macro depuis un boutton censé la lancer
mais quand je run la macro à partir de l'éditeur VBE rien ne s'affiche 🙁
la ligne d'erreur est

Sub Macro1()
'Prépare la feuille "Vierge" contenant les données importées
'Transfert "Semaine N" vers "Semaine N-1" et "Vierge" modifiée vers "Semaine N"
'Rétablit les formules de synthèse de la feuille Accueil
'le code va contenir des tests

Dim Sh_SN1 As Worksheet 'Semaine N
Dim Sh_SN0 As Worksheet 'Semaine N-1
Dim Sh_V As Worksheet 'Vierge
Dim Sh_N As Worksheet 'Nouvelle feuille

Dim NbLgn As Long, LFin As Long, NbLBis As Long, rg As Range
Application.ScreenUpdating = False

With ThisWorkbook
Set Sh_SN1 = .Worksheets("Fs_semaine N")
Set Sh_V = .Worksheets("vierge")
End With
If Sh_SN1.FilterMode Then Sh_SN1.ShowAllData

'Actions sur la feuille "Vierge"
With Sh_V
.[A:CJ].EntireColumn.Hidden = False
.[1:7].Delete Shift:=xlUp
With .Cells
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
NbLgn = .Cells(.Rows.Count, 1).End(xlUp).Row - 1 '(nombre de lignes de données de "Vierge" : Exclut ligne de titre)
If NbLgn < 1 Then
MsgBox "Pas de données dans la feuille ""Vierge""" & Chr(13) & _
"Remplir l'onglet ""Vierge"" avec les données des fichiers score (onglet exportsingle)"
Exit Sub 'Sortir s'il n"y a pas de données dans la feuille "Vierge"
End If
Set rg = .[Y2].Resize(NbLgn)
'Set rgx = .[X2].Resize(NbLgn)
rg.FormulaR1C1 = "=IF(ISBLANK(R[1]C[-10]),CONCATENATE(RC[-1],"" "",R[1]C[-1]),RC[-1])"
rg.Value = rg.Value
rg.Copy Destination:=.[X1].Resize(NbLgn)
Set rg = .[AB2].Resize(NbLgn)
rg.FormulaR1C1 = "=IF(RC[-1]=""INITIALIZATION"",RC[3],IF(RC[-1]=""INSTRUCTION"",RC[5],IF(RC[-1]=""DEVELOPMENT"",RC[7],IF(RC[-1]=""OFFICIALIZATION - INDUSTRIALIZATION"",RC[9],RC[10]))))"
rg.Value = rg.Value
End With
Rows("1:1").AutoFilter
ActiveWindow.LargeScroll ToRight:=2
ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear ******* ligne d'erreur ************
ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Add Key:=Range _
("O1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
 
Bonjour
la macro fait la mise à jour des différentes colonnes à partir de la feuille vierge
la feuille vierge contient les sujets avec des identifiants
on lance la mise à jour à partir des boutons dans l'onglet Acceuil pour lancer la mise à jour
cette mise à jour est faite chaque semaine on identifie les nouveaux sujets on les ajoute et on modifie les colonnes des identifiants déjà existants , cad anciens sujets
on fait des opérations sur la feuille vierge pour extraire que quelques colonnes et enfin on nomme vierge par semaine N et semaine N par Semaine N-1
voici le fichier
le code qui génère le problème est dans Module 12
vous pouvez lancer la mise à jour par le bouton Lancer la mise à jour des sujets ALTIS dans l'onglet accueil vous trouverez les sujets dans vierge
merci pour votre réponse
 
déjà, je pense qu'il faudrait faire du ménage dans ton fichier

le nombre de lignes vide dans tes différentes feuilles est énorme et augmente considérablement (et inutilement) la taille du fichier

==> il en résulte un temps d'execution du code beaucoup trop long

en plus. les données semblent être un peu n'importe ou dans tes feuilles
==> je vais voir ce que je peux faire

1) supprimer les lignes vides et remonter les données en haut de feuille
2) transformer les données en table structurée
 
si je comprend bien, la feuille Vierge est générée par un copier coller ou import quelconque avant de lancer la macro 1==> Correct ?
l'objectif de la macro1 est de traiter cette feuille Vierge

pourquoi tu commences par supprimer les lignes 1 à 7 ?? alors qu'elles contiennent des données??
 
Les données dans la feuille vierge sont générées par un logiciel et on les copie pour ensuite mettre à jour les sujets de la semaine N
oui la macro 1 traite cette feuille vierge
je pense qu'on va supprimer que deux premières lignes
ce qui pose problème c'est la ligne 50
 
il y a comme un pb ou deux dans ta macro...

tu appliques une formule sur la colonne Y à partir de la ligne 2 (au lieu de 3 ??)
(cette formule est censée faire quoi??)
tu fais ensuite un copier coller valeur sur la colonne Y
ensuite, tu colles Y2:Y700 sur X1:X699==> il y a donc un décalage...

ensuite tu appliques le filtre auto sur la ligne 1 (au lieu de la ligne2 ??)
puis tu fais un tri sur la colonne O
==> Ca remonte toutes les lignes qui contiennent quelque chose en O MAIS toutes les lignes qui étaient mergées .. elles sont perdues en bas...

et ensuite, tout un tas de copier coller, suppression de colonnes, suppression de feuilles et recréation... bref.. il y en a un peu dans tous les sens..

peux tu décrire étape par étape ce qu'elle est censée faire??
 
En fait.. la question pourrait sans doute se résumer à
Dans la feuille "Vierge", il y a des numéos de "Technical Event ID" en colonne A
pour chaque numéro, il peut y avoir plusieurs lignes "fusionnées"
parmi ces lignes fusionnées: tu gardes laquelle? (ou lesquelles?)

ensuite. parmi toutes les colonnes: tu gardes lesquelles??
et tu les mets où ? (dans la feuille Semaine N ?)
 
Salut , j'ai une autre version de ce même code , voici le code , je travaille sur cette version parce qu'elle est la plus simple à comprendre , mais selon vous y'a beaucoup de lignes inutiles
voici la macro1
le seul problème est une erreur dans la ligne que j'ai marqué , je saiss pas purquoi ?
merci pour votre aide
VB:
Sub Traiter_Extract_ALTIS()
     'Repère des colonnes
     Const C_A = 1, C_B = 2, C_C = 3, C_D = 4, C_E = 5, C_F = 6, C_G = 7, C_H = 8, C_I = 9, C_J = 10, C_K = 11, C_L = 12, C_M = 13, C_N = 14, C_O = 15, C_P = 16, C_Q = 17, C_R = 18, C_S = 19, C_T = 20, C_U = 21, C_V = 22, C_W = 23, C_X = 24, C_Y = 25, C_Z = 26, C_AA = 27, C_AB = 28, C_AC = 29, C_AD = 30, C_AE = 31, C_AF = 32, C_AG = 33, C_AH = 34, C_AI = 35, C_AJ = 36, C_AK = 37, C_AL = 38, C_AM = 39, C_AN = 40, C_AO = 41, C_AP = 42, C_AQ = 43, C_AR = 44, C_AS = 45, C_AT = 46, C_AU = 47, C_AV = 48, C_AW = 49, C_AX = 50, C_AY = 51, C_AZ = 52, C_BA = 53, C_BB = 54, C_BC = 55, C_BD = 56, C_BE = 57, C_BF = 58, C_BG = 59, C_BH = 60, C_BI = 61, C_BJ = 62, C_BK = 63, C_BL = 64, C_BM = 65, C_BN = 66, C_BO = 67, C_BP = 68, C_BQ = 69, C_BR = 70, C_BS = 71, C_BT = 72, C_BU = 73, C_BV = 74, C_BW = 75, C_BX = 76

     Dim Sh_ALTIS As Worksheet, Sh_Accueil As Worksheet, Sh_N As Worksheet, Sh_N_1 As Worksheet
     Dim Tout, TbRés
 
     With ThisWorkbook
          Set Sh_Accueil = .Worksheets("Accueil")
          Set Sh_ALTIS = .Worksheets("Vierge")
          Set Sh_N = .Worksheets("FS_semaine N")
          Set Sh_N_1 = .Worksheets("FS_semaine N-1")
     End With
     Application.ScreenUpdating = False
 
     FormulesAccueil = Sh_Accueil.[M4:S13].Formula
     With Sh_ALTIS
     'Pas de lignes filtrées
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
          'Récupération des données de l'extraction (à partir de la ligne 3)
          Tout = .UsedRange.Offset(2).Resize(.UsedRange.Rows.Count - 2).Value
          Application.DisplayAlerts = False: .Delete: Application.DisplayAlerts = True
     End With
     With ThisWorkbook: .Worksheets.Add after:=.Worksheets(.Worksheets.Count): End With
     ActiveSheet.Name = "Vierge"
 
     'Première ligne
     Tout(1, C_X) = IIf(Tout(2, C_O) = "", Tout(1, C_X) & " " & Tout(2, C_X), Tout(1, C_X))
     'Comptage des fiches à retenir (Col O <>"" et <>0)
     nbFiches = 0
     nbFiches = nbFiches + (Abs(Tout(1, C_O) <> "") And Tout(1, C_O) <> "0" And Tout(1, C_O) <> 0)
     'Jusqu'à l'avant-dernière
     For i = 2 To UBound(Tout) - 1
          'Compléter les valeurs des cellules fusionnées utilisées
          If Tout(i, C_S) = "" Then Tout(i, C_S) = Tout(i - 1, C_S)
          If Tout(i, C_T) = "" Then Tout(i, C_T) = Tout(i - 1, C_T)
          If Tout(i, C_AA) = "" Then Tout(i, C_AA) = Tout(i - 1, C_AA)
          If Tout(i, C_AE) = "" Then Tout(i, C_AE) = Tout(i - 1, C_AE)
          If Tout(i, C_AG) = "" Then Tout(i, C_AG) = Tout(i - 1, C_AG)
          If Tout(i, C_AI) = "" Then Tout(i, C_AI) = Tout(i - 1, C_AI)
          If Tout(i, C_AK) = "" Then Tout(i, C_AK) = Tout(i - 1, C_AK)
          If Tout(i, C_AL) = "" Then Tout(i, C_AL) = Tout(i - 1, C_AL)
          Tout(i, C_X) = IIf(Tout(i + 1, C_O) = "", Tout(i, C_X) & " " & Tout(i + 1, C_X), Tout(1, C_X))
          'Comptage des fiches à retenir (Col O <>"" et <>0)
          nbFiches = nbFiches + (Abs(Tout(i, C_O) <> "") And Tout(i, C_O) <> "0" And Tout(i, C_O) <> 0)
     Next i
     'Dernière ligne
     nbFiches = nbFiches + (Abs(Tout(i, C_O) <> "") And Tout(i, C_O) <> "0" And Tout(i, C_O) <> 0)
 
     'Dimensionnement du tableau résultat
     ReDim TbRés(C_A To nbFiches, 1 To C_O)
     j = 0
     For i = 1 To UBound(Tout)
          If Tout(i, C_O) <> "" Then
               j = j + 1
               TbRés(j, C_A) = Tout(i, C_O)
               TbRés(j, C_B) = Tout(i, C_S)
               TbRés(j, C_C) = Tout(i, C_T)
               TbRés(j, C_D) = Tout(i, C_W)
               TbRés(j, C_E) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,5,FALSE),""NEW / à éclaircir"")")
               TbRés(j, C_F) = Tout(i, C_AA)
               Select Case TbRés(j, C_F)
                    Case "INITIALIZATION": TbRés(j, C_G) = Tout(i, C_AE)
                    Case "INSTRUCTION": TbRés(j, C_G) = Tout(i, C_AG)
                    Case "DEVELOPMENT": TbRés(j, C_G) = Tout(i, C_AI)
                    Case "OFFICIALIZATION - INDUSTRIALIZATION": TbRés(j, C_G) = Tout(i, C_AK)
                    Case Else: TbRés(j, C_G) = Tout(i, C_AL)
               End Select
               TbRés(j, C_I) = Tout(i, C_X)
               TbRés(j, C_J) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,9,FALSE),""NEW / à classer"")")
               TbRés(j, C_K) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,10,FALSE),""NEW / à programmer"")")
               TbRés(j, C_L) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,11,FALSE),"""")")
               TbRés(j, C_M) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,13,FALSE),"""")")
               TbRés(j, C_N) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,14,FALSE),"""")")
               TbRés(j, C_O) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,15,FALSE),"""")")
          End If
     Next i
 
 
     With Sh_N
          'Lectures des données de l'ancienne semaine N
          Tout = .[Tb_Sn].Value    '********* ligne erreur
          'Remplissage semaine N avec les données de la nouvelle extraction
          .[Tb_Sn].ClearContents
          .[Tb_Sn].ListObject.Resize .[Tb_Sn].ListObject.Range.Resize(UBound(TbRés))
          .[Tb_Sn].Value = TbRés
     End With
 
     ' Identification dans Tout des FS de l'ancienne semaine N absentes de la nouvelle extraction
     With WorksheetFunction
     For i = 1 To UBound(Tout)
          Tout(i, C_F) = Evaluate("=IFERROR(VLOOKUP(" & Tout(i, C_A) & ",Tb_SN,6,FALSE),""soldé ou abandonné"")")
          Tout(i, C_G) = Evaluate("=IFERROR(VLOOKUP(" & Tout(i, C_A) & ",Tb_SN,7,FALSE),""soldé ou abandonné"")")
     Next
     End With
 
     'Transfert vers la semaine N-1
     With Sh_N_1
          'Remplissage semaine N-1 avec les données de l'ancienne semaine N
          .[Tb_Sn_1].ClearContents
          .[Tb_Sn_1].ListObject.Resize .[Tb_Sn_1].ListObject.Range.Resize(UBound(Tout))
          .[Tb_Sn_1].Value = Tout
     End With
      Application.ScreenUpdating = True
End Sub
 
Bonsoir le fil


@vgendron
Te retaper un autre code, non ?
Mais te taper la main droite sur le front (mais trop fort 😉)

Ah les déboires avec les nouveaux inscrits 😉
Tout un programme (qui perdure d'année en année)
 
- 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éponses
4
Affichages
332
Réponses
3
Affichages
518
Réponses
2
Affichages
371
  • Question Question
Microsoft 365 Excel VBA
Réponses
5
Affichages
339
Réponses
9
Affichages
367
Retour