Aide améliorer Macro de Mise en forme

Bonjour

J'ai un petit problème dans une Macro.

Elle fonctionne mais j'ai l'erreur 1004 a cause de Application.Undo a chaque fois, j'ai essayé divers chose mais (enlever/déplacer Undo, changer des true en false ) mais a chaque fois la macro ne fonctionne plus.

Contexte: J'ai une extraction de données d'un logiciel qui arrive comme dans l'onglet Extraction mais sur un nouveau tableur(en tableau, lien hypertexte etc), pour me simplifier la vie (je dois faire beaucoup de fiche par jour) j'ai bidoullé cette Macro pour la mise en forme.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("Table13")) Is Nothing Then

Target.Copy

Application.EnableEvents = False

Application.Undo

Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.EnableEvents = True

ActiveSheet.PageSetup.LeftFooter = Application.UserName

Application.CutCopyMode = False

ActiveWorkbook.Worksheets("Table").ListObjects("Table13").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("Table").ListObjects("Table13").Sort.SortFields.Add2 _

Key:=Range("Table13[[#Headers],[#Data],[Emplacement de référence]]"), SortOn _

:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("Table").ListObjects("Table13").Sort

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Cells.Replace What:=" / Ville / Region / France / Europe", _

Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _

False, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:= _

xlReplaceFormula2

End If

End Sub

J'y connait pas grand chose j'utilise surtout le enregistrer Macro, mais la partie Paste on me l'a donné.

Il y at-il un moyen d'avoir la macro fonctionnel mais sans le message erreur?

Merci de votre aide

Bonjour,

Votre code change n'a pas besoin d'être placé dans la feuille Table sans quoi à chaque fois que vous changez une cellule dans cette feuille le code est relancé
S'il s'agit uniquement de mettre les données de la feuille extraction dans la feuille Table, vous pouvez plus simplement mettre un code dans un module et exécuter depuis un bouton par exemple.

- Dans la colonne A le lien hypertexte ne pointe sur rien. Normal ?
- Que contiennent les colonnes où vous avez mis un /
- Comment les données arrivent-elles dans la feuille extraction
- Est-ce que vous devez chaque fois, supprimer les données de la feuille Table avant d'importer les nouvelles

Je ne vois pas l'utilité de garder le Undo puisque si j'ai bien compris, il s'agit uniquement de copier les infos de la feuille extraction vers la feuille Table

Bonjour,

Oui c'est normal pour la Colonne A, j'ai supprimer les liens puisque normalement, ils renvoient vers la page du N° dans logiciel, logiciel qui à un bouton extraction, je vous mes comment je reçois l'extraction, l'onglet dans le modèle c'était pour l'exemple, il n'y a pas d'onglet Extraction juste Table dans mon vrai modèle, je reçois cela dans un nouvelle excel à chaque et je C/C dans le modèle en caseA5.

A la place des / c'est que du texte mais j'ai anonymiser puisque l'on à des noms et d'autre info.

J'en ouvre un autre modèle à chaque fois, je suis passer par les Modèles Excel pour cela.

C'est plus copier les infos d'un excel vers un Modèle avec une mise en forme automatique puisque j'ai entre 20 et 30 fiche à faire par jour. Donc avoir juste à sélectionner les données et C/C sans avoir a faire la mise en forme me fait gagner du temps.

Merci de vos explications.

Il me faudrait :
- avoir aussi la réponse au 4ieme point de mon post précédent
- savoir si le fichier export que vous avez placé comporte le nom "export" ou un autre et s'il ce nom est toujours identique

Non je supprime pas puisque grâce au format Modèle Excel, j'ai toujours un vierge a chaque ouverture du fichier. J'enregistre, je ferme le une fois terminer, j'exporte le suivant et j'ouvre le Modèle dans Fichier=> Nouveau vu qu'il est épinglé.

Oui cela est toujours export.xlsx

Oups désolé de mes questions je n'avais pas remarqué l'extension xlTm de votre fichier qui utilisée effectivement pour le modèle excel

Procédez comme suit dans votre fichier modèle,
- supprimez le code Private Sub Worksheet_Change(ByVal Target As Range)
- allez dans le menu --> Insertion et choisissez --> Module
- dans ce module, collez le code ci-dessous

Sub extraire()
Dim tablo()
Dim dlg As Integer

On Error Resume Next
dlg = Workbooks("Export.xlsx").Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
If dlg = 0 Then
    MsgBox "Veuillez vérifier que le fichier export est ouvert !", vbCritical, "Fichier export"
    Exit Sub
End If

With ThisWorkbook.Sheets("Table").ListObjects(1)

    On Error Resume Next
    .DataBodyRange.Delete 'effacer tableau si existant
    On Error GoTo 0

    .ListRows.Add: lig = 1 'ajout ligne
    .ShowTotals = False 'enlever la ligne des totaux

    tablo = Workbooks("Export.xlsx").Sheets(1).Range("A2:F" & dlg).Value 'enregistrement des donnees depuis fichier export

    .DataBodyRange.Item(lig, 1).Resize(UBound(tablo), UBound(tablo, 2)) = tablo 'ajouter donnees dans feuille Table

    .ShowTotals = True 'remettre ligne des totaux
    .ListColumns(6).TotalsCalculation = xlTotalsCalculationCount 'ajout formule en colonne 6 - Gestionnaire
End With
End Sub

- Ajoutez un bouton en A1 par exemple
- Associez le au code ci-dessus
- Ré-enregistrez le fichier en format modèle --> donc avec l'extension XLTM

Pour le test, ouvrez le fichier "export.xlsx" puis exécutez le code

Rem : évitez les fusions de cellule comme je le vois en ligne 1 et 2 de votre feuille Table. Votre titre peut être en ligne 1 seulement. Donc défusionnez puis supprimez la ligne 2.

Si ok pensez à

Cordialement

Merci