Ciaooo a tutti
Vi chiedo aiuto per risolvere un problemino...
premetto che ho excel 2010.
In una pagina ho un'anagrafica con id, nome, cognome, ecc ... e tramite la macro sotto sposto i file pdf inerenti le persone che ho in elenco da una cartella all'altra. E nel foglio1 mi viene elencato cid (id) ed il nominativo del personale a cui è stato spostato il pdf.

ed è qui che vi chiedo aiuto...
quando vi sono file .pdf molto simili tra loro, mi vengono spostati entrambi (ed è ok) ma nella lista del foglio1 mi viene segnalata solo una vola ... vorrei che accanto al nominativo o cella adiacente, mi apparisse qualcosa tipo "DOPPIO"
Vi ringrazio anticipatamente .....

codice:
Dim xFd As FileDialog
    Dim xTFile As String
    Dim xExtArr As Variant
    Dim xext As Variant
    Dim xextf As Variant
    Dim xSPath As String
    Dim xDPath As String
    Dim xSFile As String
    Dim xCount As Long
    Dim xname As String
    Dim cid As String
    Dim nome As String
    Dim cogn As String
    Dim s As Integer
    Dim c As Integer
    Dim coll As Integer
    
    
    On Error Resume Next
    
    
    
    
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    xFd.Title = "Seleziona cartella di Origine:"
    If xFd.Show = -1 Then
        xSPath = xFd.SelectedItems(1)
    Else
        Exit Sub
    End If
    If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\"
    xFd.Title = "Seleziona cartella di Destinazione:"
    If xFd.Show = -1 Then
        xDPath = xFd.SelectedItems(1)
    Else
        Exit Sub
    End If
    If Right(xDPath, 1) <> "\" Then xDPath = xDPath + "\"
    
    Sheets("Foglio1").Columns("A2:A").Selection.ClearContents
    Sheets("Foglio1").Columns("B2:B").Selection.ClearContents
    Sheets("Foglio1").Columns("C2:C").Selection.ClearContents
    Sheets("Foglio1").Columns("D2:D").Selection.ClearContents
    Sheets("Foglio1").Range("A2").Select
    
    
    
   s = 2
   c = 2
   coll = 6 '<------  NUMERO COLONNA DI RICERCA ***********************************
   xextf = ".pdf" ' ".jpg"   <------  ESTENZIONE DEL FILE DI RICERCA ***********************************
   
For xs = 1 To 6000
    
    xname = Sheets("anagraficatn").Cells(s, coll)
    
       
    cid = Sheets("anagraficatn").Cells(s, 2)
    nome = Sheets("anagraficatn").Cells(s, 3)
    cogn = Sheets("anagraficatn").Cells(s, 4)
    
    
    xExtArr = Array(xname & xextf)

    
    
   
    For Each xext In xExtArr
        xTFile = Dir(xSPath & xext)
    
    
        If xTFile <> "" Then
        
            Sheets("Foglio1").Cells(c, 1) = cid
            Sheets("Foglio1").Cells(c, 2) = nome
            Sheets("Foglio1").Cells(c, 3) = cogn
            Sheets("Foglio1").Cells(c, 4) = xExtArr
            c = c + 1
       End If
        
        
            
            
        Do While xTFile <> ""
            
            xSFile = xSPath & xTFile
            FileCopy xSFile, xDPath & xTFile
            Kill xSFile
            xTFile = Dir
            
            xCount = xCount + 1
            
        Loop
        
         
    Next xext
    
    
    
    s = s + 1
   
   
    Next xs
    
    
    
    MsgBox "Totale numero di file spostati: " & xCount, vbInformation, "Totale file spostati"