Copier même information d'un dossier

C'est bon c'est ça en principe :

Option Explicit

Sub ConsolidationFiches()
Dim DLig As Long
Dim sFic As String, sPath As String
Dim Wbk As Workbook, ShtS As Worksheet
Dim Mondico As Object
Dim Tablo
Dim J As Long
Dim Ws As Worksheet

  Application.ScreenUpdating = False
  Set Ws = ActiveSheet

  ' Définir le chemin par défaut
  sPath = ThisWorkbook.Path & "\"
  ' Pour chaque fichier de ce dossier
  sFic = Dir(sPath)
  Do
    ' Au cas ou il s'agisse de ce classeur
    If sFic = ThisWorkbook.Name Then GoTo Suite
    ' Définir le classeur source
    Set Wbk = Workbooks.Open(sPath & sFic)
    ' Définir la feuille source
    Set ShtS = Wbk.Sheets("suivi")
    ' avec ce classeur
    With ThisWorkbook.Sheets("import")
      ShtS.Range("A1:D1").Copy Destination:=.Range("A1")
      DLig = .Range("A" & Rows.Count).End(xlUp).Row + 1
      ShtS.Range("A2:D" & ShtS.Range("A" & Rows.Count).End(xlUp).Row).Copy Destination:=.Range("A" & DLig)
    End With
    Wbk.Close
    ' Effacement des variables objet
   Set ShtS = Nothing: Set Wbk = Nothing
Suite:
    sFic = Dir
  Loop While sFic <> ""

  ' Partie distribution des infos
  Set Mondico = CreateObject("Scripting.Dictionary")
  DLig = Range("A" & Rows.Count).End(xlUp).Row
  For J = 2 To DLig
    Mondico(Range("B" & J).Value) = Range("B" & J).Value
  Next J
  Tablo = Mondico.Items

  For J = 0 To UBound(Tablo)
    If FeuilleExiste(CStr(Tablo(J))) = False Then
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Tablo(J)
    End If
    With Sheets(Tablo(J))
      Ws.Range("A1:D" & DLig).AutoFilter field:=2, Criteria1:=Tablo(J)
      Ws.Range("A1:D" & DLig).SpecialCells(xlCellTypeVisible).Copy .Range("A100")
    End With
  Next J
  Ws.Select
  Ws.Range("A1:D" & DLig).AutoFilter
End Sub

Function FeuilleExiste(nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(nom).Name <> ""
  On Error GoTo 0
End Function

Banzai64 a écrit :

Bonjour

hacka47 a écrit :

changer de référence colonne Critères (ex: dans mes fiches mes références se trouvent toujours en colonne A, mais comment changer le code pour qu'il me créé les onglets à partir non plus de la colonne A de chaque fiche, mais la colonne B par exemple.)

Dans la colonne B (déjà pas évident) tu as plusieurs noms pour le même critère de la colonne A

On fait un tirage au sort ?

Je voulais dire si maintenant j'ai mes références en colonne B au lieu de la A....

hacka47 a écrit :

- changer de début de ligne dans le dispatching dans chaque onglet (ex: je souhaite que mes lignes de données ne commencent qu'à la 101e ligne de chaque onglet, en ayant une automatisation du remplissage de la 100e ligne par la même entête : critères, descirptif1 descirptif 2 descriptif C (voir mon dernier fichier synthèse posté) :

Tu me traduis s'il te plait, je viens de regarder ton dernier fichier et rien à la 100ème ligne, les entêtes ne me semblent pas être dans un autre ordre que celui résultant de la macro

J'ai trouvé où il fallait modifier A1 par A100 pour que ça commence à la 100e ligne, avec les intitulés de colonne toujours présents.

Un grand merci à toi pour ton aide en tout cas.