Edit existing code

[Flavien]

Hi everyone,
I found on the web a code to collect the data recorded on all the workbooks of the same directory.
All workbooks have the same frame (tab name and table type).
I added "if" conditions in order to add the collection date and thus not collect the same line twice.
But it turns out that in the field, several colleagues may need to collect these lines.

But when I remove the IF lines, nothing happens.
To tell you the truth, I'm not sure I fully understand the construction of this code.

Does anyone have any idea how to go about collecting all the rows at will?

Or maybe clear all the dates before launching the code?

Thank you for your help.

Sub Collecte()

'Boucle sur tous les classeurs FNC ilot et transfère les données vers ce classeur.
'Les lignes collectées sont datées dans les fichiers sources afin d'éviter les doublons

Dim BDD As FileDialog 'déclare la variable BDD (Boîte de Dialogue Dossier)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim FS As String 'décalre la variable FS (Fichier Source)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (celllue de DESTination)


'Désactive la mise à jour de l'écran 
Application.ScreenUpdating = False

'chemin d'accès au dossier de stockage des classeurs FNC Ilots
CA = "P:\01-Qualité\K - Qualité Usinage\00 - Modèle" & "\"

Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Sheets("SUIVI") 'définit l'onglet destination OD
FS = Dir(CA & "TABLEAU DES FNC_*.xlsx") 'définit le premier fichier source Excel contenu dans le dossier ayant CA comme chemin d'accès
Do While FS <> "" ' exécute tant qu'il existe des fichiers source
    Workbooks.Open CA & FS 'ouvre le fichier source FS
    Set CS = ActiveWorkbook 'définit la classeur source CS
    Set OS = CS.Worksheets("Tableau FNC") 'définit l'onglet source OS (à adapter à ton cas, ici j'ai mis le premier onglet)



For I = 2 To OS.Range("B65536").End(xlUp).Row
    If OS.Cells(I, 1) <> "" And OS.Cells(I, 60) = "" Then OS.Cells(I, 60) = "x"
Next I


For I = 2 To OS.Range("B65536").End(xlUp).Row
    If OS.Cells(I, 60) = "x" Then OS.Rows(I).Copy OD.Rows(OD.Cells(OD.Rows.Count, 2).End(xlUp).Row + 1)
Next I

For I = 2 To OS.Range("B65536").End(xlUp).Row
    If OS.Cells(I, 60) = "x" Then OS.Cells(I, 60) = Date
Next I


'Active la mise à jour de l'écran pour accélérer l'exécution
Application.ScreenUpdating = True


    CS.Close True 'ferme le claseur source CS (False sans enregistrer)
    FS = Dir 'définit le prochain fichier source excel du dossier ayant CA comme chemin d'accès
Loop 'boucle

' activer le classeur "tableau de suivi des FNC_Qualité et remplacer les X par la date du jour
Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Sheets("SUIVI") 'définit l'onglet destination OD (à adapter à ton cas, ici j'ai mis l'onglet "suivi")

For I = 2 To OD.Range("B65536").End(xlUp).Row
    If OD.Cells(I, 60) = "x" Then OD.Cells(I, 60) = Date
Next I

End Sub

 

[Flavien]

Hello Micron,

Thank you for your answer.

You are right it's would be easier to write each user name in the same cell, but unfortunately, i don't know how to deal with the code you gave me.