Macro cerca valore e se trovato copia

[Flash30005]

Penso di aver capito
hai un codice sporco che non è un numero ma avrà uno spazio o altro carattere all'interno della cella

[Flash30005]

Se hai stringhe e non numeri sostituisci la definizione delle variabili da Long a string così

Codice: Seleziona tutto

Dim TVEI1 As String, TVEI3 As String

fai sapere

[Filippo1970]

L'errore lo da nella riga

Codice: Seleziona tutto

  TVEI1 = Uno.Range("A" & RR1).Value

Purtroppo qui dall'ufficio non mi fa scaricare il file

[Flash30005]

Leggi il post precedente e sostituisci la riga indicata

ciao

[Filippo1970]

OK funzionaaaaa!!!!
Ho lanciato la macro sul primo file e sembra tutto ok.
Procedo a fare altri controlli e faccio sapere
Grazie mille per ora

[Flash30005]

Leggi gli MP ne hai uno in sospeso...

ciao

[ricky53]

Ciao,
prima leggi i messaggi di Flash.

Prima di tutto una DOMANDA: tu vuoi ACCODARE, nel Foglio2, i codici del Foglio 3 a quelli esistenti oppure cancellare gli esistenti e scrivere i nuovi ???


Ho scaricato i tuoi due file.
Ho integrato la macro che ti avevo inviato e rimosso l'anomalia che avevi segnalato (era causata da codici scritti nel foglio3 ma NON presenti nel foglio1)

Ho messo anche il controllo sul NON trovato ed il conteggio dei trovati e dei non trovati.
Ho eseguito la macro sul tuo file che aveva 55 codici da copiare, "11" erano presenti e "44" no.

Codice: Seleziona tutto

Option Explicit

Sub Copia_Dati_TVEI()
    Dim K As Long, WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet, UR1 As Long, UR2 As Long, UR3 As Long, NonTrovati As Integer, Trovati As Integer, Messaggio As String
   
    Set WS1 = Sheets("Foglio1")
    Set WS2 = Sheets("Foglio2")
    Set WS3 = Sheets("Foglio3")
   
    UR3 = WS3.Range("A" & Rows.Count).End(xlUp).Row
    If UR3 = 1 Then
        MsgBox "Non sono stati inseriti TVEI da copiare. L'elaborazione viene interrotta", vbCritical
        Exit Sub
    End If
   
    Application.ScreenUpdating = False
    WS1.Select
    WS1.Range("A1").Select
    NonTrovati = 0
    Trovati = 0
    For K = 2 To UR3
        Selection.AutoFilter
        Selection.AutoFilter Field:=1, Criteria1:="<>"
        ActiveSheet.ShowAllData
        Selection.AutoFilter Field:=1, Criteria1:=WS3.Cells(K, 1)
        UR1 = WS1.Range("A" & Rows.Count).End(xlUp).Row
        UR2 = WS2.Range("A" & Rows.Count).End(xlUp).Row + 1
        If UR2 = 2 And WS2.Range("A1") = "" Then
            WS1.Range("A1:E1").Copy Destination:=WS2.Range("A1")
        End If
        If UR1 > 1 Then
            Trovati = Trovati + 1
            WS3.Cells(K, 2) = "Codice COPIATO"
            WS1.Range("A2:E" & UR1).Copy Destination:=WS2.Range("A" & UR2)
        Else
            NonTrovati = NonTrovati + 1
            WS3.Cells(K, 2) = "Codice non presente"
        End If
        Application.CutCopyMode = False
    Next K
    ActiveSheet.ShowAllData
    WS3.Columns(2).ColumnWidth = 20
    Application.ScreenUpdating = True
   
    Messaggio = "Copia di  '" & Trovati & "'  TVEI effettuata"
    If NonTrovati > 0 Then
        Messaggio = Messaggio & Chr(10) & Chr(10) & "Non sono stati trovati  '" & NonTrovati & "'  codici TVEI"
        MsgBox Messaggio, vbExclamation
    Else
        MsgBox Messaggio, vbInformation
    End If
   
    Set WS1 = Nothing
    Set WS2 = Nothing
    Set WS3 = Nothing
End Sub

Prova e sono QUI