Incrementation cellule suite recherche dans un tableau

Bonjour à tous,

Dans le cadre de mon travail je dois réaliser un développement VBA permettant de gagner du temps sur tache répétitive.

L'automatisation serait la suivante:

J'ai une liste de x numéros dans fichier excel 1

Dans un fichier excel 2 j'ai un tableau avec tous les numéros susceptibles d'être présent dans le fichier excel 1.

A chaque numéro est associé un commentaire.

Mon automatisation doit permettre de rapprocher chaque commentaire au numéro qui lui correspond dans le fichier excel 1.

J'ai presque réussi en faisant une recherche V mais le problème est que le nom du fichier 1 s'inscrit en dur dans mon code VBA, je pensais qu'il serait possible de faire cette opération avec une boucle mais mes connaissances sont limités dans ce domaine.

Voici ce que j'ai pour l'instant

Sub messerreur()

    ActiveWindow.SmallScroll ToRight:=10
    Range("N2").Select
    ActiveWindow.FreezePanes = True
    ActiveWindow.SmallScroll ToRight:=9
    Columns("W:W").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("W2").Select
    ActiveCell.FormulaR1C1 = "=CONCAT(RC[-12]:RC[-10])"
    Range("W2").Select
    Selection.AutoFill Destination:=Range("W2:W401")
    'Range("W2:W401").Select
    Range("X2").Select
    Workbooks.Open Filename:= _
        "L:adresse du fichier"
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.NumberFormat = "General"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=CONCAT(RC[-3]:RC[-1])"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D1802")
    Range("D2:D1802").Select
    Windows("Nom du fichier excel 1.xls"). _
        Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-1],'[Nom du fichier excel 2.xlsx]Feuil1'!R2C4:R1802C5,2,FALSE)"
    Range("X2").Select
    Selection.AutoFill Destination:=Range("X2:X401")
    Range("X2:X401").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("W:W").Select
    Selection.Delete Shift:=xlToLeft
    Application.CutCopyMode = False
    Range("W2").Select
    Windows("Nom du fichier excel 2.xlsx").Activate
    ActiveWorkbook.Close
    ActiveWorkbook.Save
End Sub

Merci beaucoup pour votre aide

Alexis

Bonjour,

dans un premier temps ... tu pourrais rationaliser un peu ta macro ...

Sub MesErreurs()
Dim wkb1 As Workbook
Dim wkb2 As Workbook

    Set wkb1 = ActiveWorkbook
    With wkb1.ActiveSheet
      .Columns("W:W").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
      .Range("W2").FormulaR1C1 = "=CONCAT(RC[-12]:RC[-10])"
      .Range("W2").Copy Destination:=.Range("W3:W401")
    End With

    Workbooks.Open Filename:="Ladresse du fichier"
    Set wkb2 = ActiveWorkbook
    With wkb2.ActiveSheet
      .Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
      .Columns("D:D").NumberFormat = "General"
      .Range("D2").FormulaR1C1 = "=CONCAT(RC[-3]:RC[-1])"
      .Range("D2").Copy Destination:=.Range("D3:D1802")
    End With

    wkb1.Activate
    wkb1.ActiveSheet.Range("X2").FormulaR1C1 = _
        "=VLOOKUP(RC[-1],'[Nom du fichier excel 2.xlsx]Feuil1'!R2C4:R1802C5,2,FALSE)"
    wkb1.ActiveSheet.Range("X2").Copy Destination:=wkb1.ActiveSheet.Range("X3:X401")
    wkb1.ActiveSheet.Range("X2:X401").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues

    wkb1.ActiveSheet.Columns("W:W").Delete Shift:=xlToLeft
    Application.CutCopyMode = False
    wkb1.ActiveSheet.Range("W2").Select

    wkb2.Close False
    wkb1.Save
End Sub

En espèrant que cela t'aide ...

Bonjour à tous

A faire une macro, autant essayer de l'optimiser.

Mais, pour cela il faudrait disposer des fichiers, même anonymisés...

Bye !

James007 a écrit :

Bonjour,

dans un premier temps ... tu pourrais rationaliser un peu ta macro ...

Sub MesErreurs()
Dim wkb1 As Workbook
Dim wkb2 As Workbook

    Set wkb1 = ActiveWorkbook
    With wkb1.ActiveSheet
      .Columns("W:W").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
      .Range("W2").FormulaR1C1 = "=CONCAT(RC[-12]:RC[-10])"
      .Range("W2").Copy Destination:=.Range("W3:W401")
    End With

    Workbooks.Open Filename:="Ladresse du fichier"
    Set wkb2 = ActiveWorkbook
    With wkb2.ActiveSheet
      .Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
      .Columns("D:D").NumberFormat = "General"
      .Range("D2").FormulaR1C1 = "=CONCAT(RC[-3]:RC[-1])"
      .Range("D2").Copy Destination:=.Range("D3:D1802")
    End With

    wkb1.Activate
    wkb1.ActiveSheet.Range("X2").FormulaR1C1 = _
        "=VLOOKUP(RC[-1],'[Nom du fichier excel 2.xlsx]Feuil1'!R2C4:R1802C5,2,FALSE)"
    wkb1.ActiveSheet.Range("X2").Copy Destination:=wkb1.ActiveSheet.Range("X3:X401")
    wkb1.ActiveSheet.Range("X2:X401").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues

    wkb1.ActiveSheet.Columns("W:W").Delete Shift:=xlToLeft
    Application.CutCopyMode = False
    wkb1.ActiveSheet.Range("W2").Select

    wkb2.Close False
    wkb1.Save
End Sub

En espèrant que cela t'aide ...

Bonjour James

Merci pour ton retour, en effet mon vba n'était pas optimisé car il a été créé avec l'enregistreur de macro.

J'ai testé le code que tu ma fourni, j'arrive à le dérouler entièrement mais la rechercheV ne me ressort que des #N/A.

gmb a écrit :

Bonjour à tous

A faire une macro, autant essayer de l'optimiser.

Mais, pour cela il faudrait disposer des fichiers, même anonymisés...

Bye !

Bonjour GMB

Je joints donc deux fichiers qui sont représentatifs de ceux que je devrais utiliser.

• Dans le fichier 1 il faut récupérer chaque numéro de la colonne D (le nombre peut varier)
• les comparer avec les nombre de la colonne D du fichier 2,
• si la colonne E du fichier 2 est renseignée, il faut reporter le commentaire dans le fichier 1 en face du numéro associé.

Merci pour votre aide

Bonjour

Un essai à tester. Te convient-il ?

Bye !