Macro erreur 91

Le 12/11/2024 à 20:21

Bonjour,

Afin de mettre en forme des extractions, une macro a été créée sur le fichier joint avec bouton.

Pour la 1 ere extraction "extraction brute" cela fonctionne très bien mais pas pour l'extraction brute 2 non .

Les extractions sont issues d'un logiciel et donc la quantité de données n'est jamais la même

Voici le message :

image

Pouvez vous m'aider à résoudre cela ?

Je vous joins :

1_ le fichier contenant la macro

2_ le fichier extractionbrute pour lequel la macro fonctionnait

3 le fichier extraction brute 2 pour lequel la macro ne fonctionne pas

14mef-extraction.xlsb (25.43 Ko)
9extraction-brute-2.xlsx (212.88 Ko)
12extraction-brute.xlsx (28.15 Ko)

PS: je ne suis pas douée pour les macros :)

je vous remercie pour votre aide précieuse

Le 13/11/2024 à 00:21

bonjour,

Les fichiers extraction n'ont pas la même structure.

Dans l'un (extraction-2) une information importante pour la sélection "Type (Nouveau, Reconduit, Modifié)" se trouve en colonne 6 et dans l'autre (extraction) en colonne 9. La macro est faite pour faire son traitement en fonction de la colonne 9.

L'erreur survient quand il n'y a aucune ligne sélectionnée

Le 13/11/2024 à 10:07

Bonjour,

Je vous remercie pour votre réponse.

J'ai modifié dans le code et cela fonctionne, je n'ai plus le message d'erreur.

En revanche, les données dans le fichier obtenu sont décalées dans les colonnes. Je m'explique:

par exemple :

les données de la colonne J devrait être en colonne M "Type (Nouveau, Reconduit, Modifié)"

celles de la colonne K en colonne I "CPF"

colonne R en H

Comment modifier la macro?

Ci-dessous le code macro:

Option Explicit
Option Compare Text

Sub MefExtrac()
Dim rngSrc As Range
Dim wsSrc As Worksheet
Dim nLigSrc As Long
Dim nLigSrcFin As Long
Dim wbCbl As Workbook
Dim wsCbl As Worksheet
Dim tsCbl As ListObject
Dim avDataCbl() As Variant
Dim lRuptMaj As Boolean
' Cibler l'extraction brute (le classeur doit être ouvert)
On Error Resume Next
Set rngSrc = Application.InputBox(Prompt:="Sélectionner une cellule quelconque de la feuille contenant l'extraction brute ...", Title:="Cibler l'extraction brute", Type:=8)
If Err.Number <> 0 Then
MsgBox "Extraction brute non cilblée ...", vbExclamation, "Abandon mise en forme"
Err.Clear
On Error GoTo 0
Exit Sub
End If

On Error GoTo Err_ME
Application.ScreenUpdating = False

' Pointeur sur la feuille de l'extraction brute
Set wsSrc = Workbooks(rngSrc.Parent.Parent.Name).Worksheets(rngSrc.Parent.Name)
' Pointeur vers le nouveau classeur contenant l'extraction mise en forme
Set wbCbl = Application.Workbooks.Add
Set wsCbl = wbCbl.Worksheets(1)
wsCbl.Name = "suivi de fabrication "
' Copie du tableau modèle (vide) dans un nouveau classeur
ThisWorkbook.Worksheets("Modèle extraction").ListObjects("TExtraction").Range.Copy Destination:=wsCbl.Range("A1")
Set tsCbl = wsCbl.Range("A1").ListObject
' Nommer la 1ère colonne du TS du nom de l'extraction
tsCbl.ListColumns(1).Name = wsSrc.Range("A1").Value
' Traitement de l'extraction brute
nLigSrcFin = wsSrc.Range("A1").SpecialCells(xlLastCell).Row
ReDim avDataCbl(1 To tsCbl.ListColumns.Count)
nLigSrc = 2
lRuptMaj = True
With wsSrc
While nLigSrc <= nLigSrcFin
If .Cells(nLigSrc, 1).Value = "Name" Or .Cells(nLigSrc, 1).Value = "Subitems" Then

ElseIf lRuptMaj = True And .Cells(nLigSrc, 1).Value <> "" Then
avDataCbl(1) = .Cells(nLigSrc, 1).Value ' 1 - Rupture majeure
avDataCbl(2) = "?" ' 2 - Famille
avDataCbl(3) = "?" ' 3 - Groupe
' sauter la ligne de titre
'nLigSrc = nLigSrc + 1
lRuptMaj = False
ElseIf lRuptMaj = False And .Cells(nLigSrc, 1).Value <> "" Then
avDataCbl(5) = .Cells(nLigSrc, 1).Value ' 5 - Suivi de fabrication
' sauter la ligne de titre
'nLigSrc = nLigSrc + 1
ElseIf lRuptMaj = False And .Cells(nLigSrc, 2).Value <> "" Then
If .Cells(nLigSrc, 6).Value = "Nouveau" Then
avDataCbl(4) = nLigSrc ' 4 - Numérotation tableau
avDataCbl(6) = .Cells(nLigSrc, 2).Value ' 6 - Name
avDataCbl(7) = .Cells(nLigSrc, 3).Value ' 7 - Libellé article
avDataCbl(8) = .Cells(nLigSrc, 4).Value ' 8 - Libellé abrégé article
avDataCbl(9) = .Cells(nLigSrc, 5).Value ' 9 - CPF
avDataCbl(10) = .Cells(nLigSrc, 6).Value ' 10 - Nb h apprenant
avDataCbl(11) = .Cells(nLigSrc, 7).Value ' 11 - C. Mère
avDataCbl(12) = .Cells(nLigSrc, 8).Value ' 12 - C. Fille (PA)
avDataCbl(13) = .Cells(nLigSrc, 9).Value ' 13 - Type
avDataCbl(14) = .Cells(nLigSrc, 10).Value ' 14 - Intervenants Conception
avDataCbl(15) = .Cells(nLigSrc, 11).Value ' 15 - Nb pages source Word/PDF
avDataCbl(16) = "" ' 16 - Nb pages source CEN
avDataCbl(17) = "" ' 17 - Nb éléments Moodle
avDataCbl(18) = .Cells(nLigSrc, 12).Value ' 18 - Prév fin de conception
avDataCbl(19) = .Cells(nLigSrc, 13).Value ' 19 - Prév livraison auteur
avDataCbl(20) = .Cells(nLigSrc, 14).Value ' 20 - Prév intégration LMS
avDataCbl(21) = .Cells(nLigSrc, 17).Value ' 21 - Budget prév. commandes auteurs
avDataCbl(22) = .Cells(nLigSrc, 18).Value ' 22 - Budget rectificatif (suivi mai N+1)
avDataCbl(23) = .Cells(nLigSrc, 19).Value ' 23 - Montant commande réel engagé

' Mettre à jour le tableau cible
tsCbl.ListRows.Add.Range = avDataCbl

End If
Else
lRuptMaj = True
End If
nLigSrc = nLigSrc + 1
Wend
' Largeur automatique des colonnes
tsCbl.DataBodyRange.EntireColumn.AutoFit

End With

' libération des variables objet
Set tsCbl = Nothing
Set wsCbl = Nothing
Set wbCbl = Nothing
Set wsSrc = Nothing

On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub

Err_ME:
MsgBox "L'erreur suivante s'est produite : " & Err.Number & " - " & Err.Description, vbCritical, "Mise en forme extractuon brute"
Err.Clear
' libération des variables objet
Set tsCbl = Nothing
Set wsCbl = Nothing
Set wbCbl = Nothing
Set wsSrc = Nothing

On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub

End Sub

edit modération : code mis entre balises code (bouton </>), merci d'y penser à l'avenir.

merci beaucoup !!

Le 13/11/2024 à 10:23

bonjour,

ces instructions-ci font la correspondance entre les colonnes du fichier d'entrée et le fichier de sortie, que tu devrais adapter si cela ne convient pas.

               avDataCbl(4) = nLigSrc                       ' 4  - Numérotation tableau
               avDataCbl(6) = .Cells(nLigSrc, 2).Value      ' 6  - Name
               avDataCbl(7) = .Cells(nLigSrc, 3).Value      ' 7  - Libellé article
               avDataCbl(8) = .Cells(nLigSrc, 4).Value      ' 8  - Libellé abrégé article
               avDataCbl(9) = .Cells(nLigSrc, 5).Value      ' 9  - CPF
               avDataCbl(10) = .Cells(nLigSrc, 6).Value     ' 10 - Nb h apprenant
               avDataCbl(11) = .Cells(nLigSrc, 7).Value     ' 11 - C. Mère
               avDataCbl(12) = .Cells(nLigSrc, 8).Value     ' 12 - C. Fille (PA)
               avDataCbl(13) = .Cells(nLigSrc, 9).Value     ' 13 - Type
               avDataCbl(14) = .Cells(nLigSrc, 10).Value    ' 14 - Intervenants Conception
               avDataCbl(15) = .Cells(nLigSrc, 11).Value    ' 15 - Nb pages source Word/PDF
               avDataCbl(16) = ""                           ' 16 - Nb pages source CEN
               avDataCbl(17) = ""                           ' 17 - Nb éléments Moodle
               avDataCbl(18) = .Cells(nLigSrc, 12).Value    ' 18 - Prév fin de conception
               avDataCbl(19) = .Cells(nLigSrc, 13).Value    ' 19 - Prév livraison auteur
               avDataCbl(20) = .Cells(nLigSrc, 14).Value    ' 20 - Prév intégration LMS
               avDataCbl(21) = .Cells(nLigSrc, 17).Value    ' 21 - Budget prév. commandes auteurs
               avDataCbl(22) = .Cells(nLigSrc, 18).Value    ' 22 - Budget rectificatif (suivi mai N+1)
               avDataCbl(23) = .Cells(nLigSrc, 19).Value    ' 23 - Montant commande réel engagé

par exemple le type en colonne 9 dans ton fichier d'entrée va en colonne 13 dans ton fichier de sortie.

Le 14/11/2024 à 16:41

Bonjour

je vous remercie !!

J ai effectué les modifications et tout fonctionne

Le 14/11/2024 à 17:18

Content que tu aies pu faire la correction qui te convient !

Rechercher des sujets similaires à "macro erreur"