Recherche V dans le derniers tableau Excel ouvert

Le 07/08/2023 à 06:50
Bonjour à tous,

Je suis bloqué sur la fin de ma macro concernant la demande d'une recherche V dans le tableau ouvert juste avant je vous mais le code ci-dessous.... 
' Trouver le nom du csv
  sFic = Dir(sPath & "ARTICLE_A_L_OFFICE_" & NOff & "*.csv")
  If sFic = "" Then
    MsgBox "Problème pour trouver le fichier CSV", vbCritical, "OUPS"
    Exit Sub
  End If
  ' Si fichier trouvé dernier fichier ouvert 
  Workbooks.OpenText (sPath & sFic), Origin:=xlWindows, StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C199")
    Range("C2:C199").Select
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Windows("Outils Appro office site extérieur Dourdan.xlsx").Activate
    'RechercheV dans le dernier fichier ouvert 
    ActiveCell.FormulaR1C1 = _
    "=VLOOKUP(RC[-3],'ARTICLE_A_L_OFFICE_" & NOff & "*.csv'!C2:C4,3,0)"

Merci a vous

Le 07/08/2023 à 08:03

Bonjour Baptiste

Tu ne nous dis pas quel est le problème

En revanche par rapport au code, tu n'utilises pas les variables objet, il faut !
Ca donne un truc du style

Dim WbkCSV As Workbook, ShtCSV As Worksheet
  Dim sPAth As String, sFic As String
  Dim dLig As Long
  ' Trouver le nom du csv
  sFic = Dir(sPAth & "ARTICLE_A_L_OFFICE_" & NOff & "*.csv")
  If sFic = "" Then
    MsgBox "Problème pour trouver le fichier CSV", vbCritical, "OUPS"
    Exit Sub
  End If
  ' Si fichier trouvé dernier fichier ouvert
  Set wbks = Workbooks.OpenText(sPAth & sFic, Origin:=xlWindows, StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True)
  With WbkCSV.Sheets(1)
    .Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    With .Range("C2")
      .FormulaR1C1 = "=TRIM(RC[-1])"
      .AutoFill Destination:=Range("C2:C199")
    End With
    .Range("C2:C199").Copy
    .Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
    .Columns("C:C").Delete Shift:=xlToLeft
    Application.CutCopyMode = False
    dLig = .Range("B2").End(xlDown)
  End With
    '
    With Workbooks("Outils Appro office site extérieur Dourdan.xlsx")
      .Activate
      'RechercheV dans le dernier fichier ouvert
      ActiveCell.FormulaR1C1 = _
       "=VLOOKUP(RC[-3],'ARTICLE_A_L_OFFICE_" & NOff & "*.csv'!C2:C4,3,0)"
    End With

A+

Le 07/08/2023 à 09:05
Bonjour Bruno,
Mon problème c'est qu'il ne trouve pas le dernier fichier ouvert où je souhaite faire la recherche V,
il me le retrouve bien et me fait les formules demander avant de devoir faire ma recherche V c'est une fois la demande de recherche dans ce fameux fichier, qu'il me mais un code erreur…
image

Voici la macro en intégralité. 

Sub officeDourdanTestB()

  Dim UsN As String
  Dim sPAth As String, sFic As String
  Dim NOff As Integer

  Range("Num_Office").Select
  NOff = Selection.Value

    Sheets("Y coller article à l'office").Select
    Range("A2").Select
    'fichier implatation article a office+configurationCSV

   'Workbooks.OpenText ("Z:\PEREIRA\Implantation\ARTICLE_A_L_OFFICE_3341.csv"), Origin:=xlWindows, _StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True
  'Recherche Fichier d'implantation dans USER
  UsN = UCase(Environ("username"))
  Select Case UsN
  Case "PEREIRA" 'Baptiste
      sPAth = "Z:\PEREIRA\Implantation\"
  Case "TASSOT" 'Nicolas
      sPAth = "Y:\TASSOT\Implantation\"
  Case "PABON" 'Sylvain
      sPAth = "Z:\PABON\Implantation\"
  End Select
  ' Trouver le nom du csv
  sFic = Dir(sPAth & "ARTICLE_A_L_OFFICE_" & NOff & ".csv")
  If sFic = "" Then
    MsgBox "Problème pour trouver le fichier CSV", vbCritical, "OUPS"
    Exit Sub
  End If
  ' Si fichier trouvé
  Workbooks.OpenText (sPAth & sFic), Origin:=xlWindows, StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True

    'Operation d'implation d'office avec suppresion d'espace + copier/coller dans le fichier Appro site extereieur Office dans l'onglet " YcollerBO"
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C20000")
    Range("C2:C20000").Select
    ActiveWindow.SmallScroll Down:=-24
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=-249
    Range("B2:D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("Outils Appro office site extérieur Dourdan.xlsx").Activate
    ActiveSheet.Paste
    'ActiveWindow.SmallScroll Down:=129
    'Range("E141").Select
    'Application.CutCopyMode = False
    'Selection.AutoFill Destination:=Range("E141:E328")
    'Range("E141:E328").Select
    Range("D2").Select

    ' Workbooks.OpenText ("Z:\PEREIRA\Implantation\ARTICLE_A_L_OFFICE_3341 - HORS CHAINE UNIQ.csv"), Origin:=xlWindows, _
    StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True

    'fichier implatation article a office hors chaine + configurationCSV
  UsN = UCase(Environ("username"))
  Select Case UsN
  Case "PEREIRA"
      sPAth = "Z:\PEREIRA\Implantation\"
  Case "TASSOT"
      sPAth = "Y:\TASSOT\Implantation\"
  Case "PABON"
      sPAth = "Z:\PABON\Implantation\"
  End Select
  ' Trouver le nom du csv
  sFic = Dir(sPAth & "ARTICLE_A_L_OFFICE_" & NOff & "*.csv")
  If sFic = "" Then
    MsgBox "Problème pour trouver le fichier CSV", vbCritical, "OUPS"
    Exit Sub
  End If
  ' Si fichier trouvé
  Workbooks.OpenText (sPAth & sFic), Origin:=xlWindows, StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C199")
    Range("C2:C199").Select
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Windows("Outils Appro office site extérieur Dourdan.xlsx").Activate
    ActiveCell.FormulaR1C1 = _
    "=VLOOKUP(RC[-3],'ARTICLE_A_L_OFFICE_" & NOff & "*.csv'!C2:C4,3,0)"
    Selection.AutoFill Destination:=Range("D2:D300")
    Range("D2:D300").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

   MsgBox ("C'est fini :)  !!!")

End Sub

J'espère t'avoir donner assez d'information sur ma demande.

Le 07/08/2023 à 09:10

Voici les 3 fichiers dans l'ordre d'ouverture demander…

15outils-appro-office-site-exterieur-dourdan.zip (194.43 Ko)
11article-a-l-office-3341.csv (45.66 Ko)
12article-a-l-office-3341-hors-chaine-uniq.zip (12.07 Ko)
Le 08/08/2023 à 11:46
Bonjour;
Après plusieurs recherches ceux la seront pas plus simples de demande à la macro de faire une recherche V ? dans le dernier fichier qu'il vient d'ouvrir?

Car après plusieurs tentatives je n'arrive Tjrs pas à résoudre ce problème même en cherchant sur le forum.

Merci à vous.
Le 10/08/2023 à 10:54

Bonjour Baptiste,

je viens de dézipper votre fichier "Outils-appro" mais c'est un fichier ".xlsx" et non ".xlsm"

Comment voulez-vous qu'on puisse vous aider si vous ne mettez pas votre vrai fichier de travail (anonymisé)

A+

Le 10/08/2023 à 12:03

Bonjour Bruno,

Effectivement je viens de m'apercevoir des formats des fichiers, je transmets les fichiers dans les formats initiaux, pour le fichier (anonymisé), ce n'est pas moi qui les créer, comment faire pour que vous puissiez avoirs accès ?

A+

Edit modo : même fichiers, ne servent donc à rien, supprimés

Rechercher des sujets similaires à "recherche derniers tableau ouvert"