Trasferimento dati tra fogli

[Ricky0185]

Buonasera, solito problema che era già stato risolto nella mia precedente richiesta del 13.12.25 con soluzioni suggerite sia da Anthony che da Raffaele.
Purtroppo con linguaggi troppo avanzati per la mia conoscenza del vba, per cui non riesco a personalizzare sia i dati di origine che quelli dei target.
L’ultima scelta è stato il suggerimento di Raffaele https://we.tl/t-M9b6DZNAxk che, come detto, non riesco a personalizzare mancando, come usa fare Anthony, le freccette dove si suggerisce di inserire I propri dati.
Comunque nel file allegato, super ridotto, ci sono i due fogli interessati dai trasferimenti e su uno anche spiegazioni e risultato desiderato.
Scusandomi per la ripetività della richiesta e ringraziando per l’aiuto, porgo
Cordiali saluti
R

[Dylan666]

Lascio il link della discussione collegata per aiutare chi vuole aiutare
viewtopic.php?f=26&t=113699

[Ricky0185]

Denkiù

[Raffaele53]

Forse non ho capito, la volta successiva riscrivi ancora in colonna "I" ???
Se cancelli le celle gialle questo codice le riscrive

Codice: Seleziona tutto

Option Explicit
Sub Foglio2_a_Foglio1_Bis()
Dim X As Long, Riga As Long, Nome As String
    For X = 2 To 150 'cl In Sheets("Foglio2").Range("b2:b150")
        If Sheets("Foglio2").Cells(X, "B") = "" Then Exit For 'alla cella vuota esco dal ciclo
        Nome = Sheets("Foglio2").Cells(X, "B")
        Riga = Application.Evaluate("IFERROR(LOOKUP(3,1/(Foglio1!C1:C1000=""" & Nome & """),ROW(C1:C1000)),0)")
        If Riga <> 0 Then Sheets("Foglio1").Cells(Riga, "I") = Sheets("Foglio2").Cells(X, "E").Value
    Next X
MsgBox "Fatto"
End Sub

[Ricky0185]

Ho dimenticato evidenziare che il file deve girare in excel 2003 e che nel foglio1 sono registrate per ogni nominativo diverse voci ( i numeri, che poi sono rate o versamenti) che spaziano da 1 a 6-7, alcuni ne hanno 1, altri 2, altri3, etc. e che il numero riportato nella colonna I e pescato per pari nominativo dal foglio2 dovrebbe essere sempre posizionato in colonna I, ma sempre nella riga dell'ultima registrazione o, quando ce ne una sola, sulla riga che è unica. Come evidenziato dalle celle gialle.
La tua macro va in errore di run-time 13 Tipo non corrispondente, evdenziando in giallo la Riga=Application.Evaluate....etc.
Ciao

[Anthony47]

Va in errore perchè XL2003 non ha la funzione IFERROR.
Una possibile alternativa:

Codice: Seleziona tutto

Sub RiportaA()
Dim SRan As Range, NRan As Range, myMatch
Dim I As Long, WK1, Msg As String
'
Set SRan = Sheets("Foglio2").Range("A2")    '<< L'inizio della tabella di Origine
'
Sheets("Foglio1").Select
Set NRan = Range(Range("C1"), Cells(Rows.Count, "C").End(xlUp).Offset(20, 0))
Set SRan = Range(SRan, SRan.End(xlDown))
NRan.Offset(, 6).Interior.Color = xlNone                                '?? Toglie GIALLO in colonna I ??
NRan.Offset(, 6).ClearContents                                          '?? Pulisce colonna I ??
For I = 1 To SRan.Rows.Count
    WK1 = Evaluate("max(if(" & NRan.Address & "=""" & SRan.Cells(I, 2) & """,row(" & NRan.Address & "),0))")         'Ultima riga occupata
    If WK1 = 0 Then
        'Nome non trovato su foglio1
        Msg = Msg & SRan.Cells(I, 2) & ", "
    Else
        Cells(WK1, "I").Value = SRan.Cells(I, 5)                                    'Compila valore
        Cells(WK1, "I").Interior.ColorIndex = 6                         '?? Mette GIALLO su colonna I
    End If
Next I
'Completato, report:
If Len(Msg) > 1 Then
    MsgBox ("Completato, con errore su Nomi:" & vbCrLf & Msg)
    Debug.Print ("Completato, con errore su Nomi:" & Msg)
Else
    MsgBox ("Completato")
End If
End Sub


Ciao

[Ricky0185]

Perfetto. Grazie a te ed a Raffaele.
Buon Fine Settimana
R

[Ricky0185]

Per confermare che la macro di Raffaele su excel 21 fa esattamente il suo sporco lavoro come quella di Anthony sul 2003. Mi sarei meravigliato del contrario.

[Anthony47]

Ovviamente funziona anche su XL2003, se elimini la IFERROR:

Codice: Seleziona tutto

        Riga = Application.Evaluate("(LOOKUP(3,1/(Foglio1!C1:C1000=""" & Nome & """),ROW(C1:C1000)))")    'Per XL2003

Tuttavia in questo modo la macro va in debug se il nome cercato non è presente su Foglio1, quindi andrebbe aggiunta qualche altra istruzione per gestire quell'evenienza

[Raffaele53]

Codice: Seleziona tutto

Sub Foglio2_a_Foglio1_Bis()
Dim X As Long, Riga As Long, Nome As String
    For X = 2 To 150 'cl In Sheets("Foglio2").Range("b2:b150")
        If Sheets("Foglio2").Cells(X, "B") = "" Then Exit For 'alla cella vuota esco dal ciclo
        Nome = Sheets("Foglio2").Cells(X, "B")
        On Error Resume Next
        Riga = Application.Evaluate("LOOKUP(3,1/(Foglio1!C1:C1000=""" & Nome & """),ROW(C1:C1000))")
        If Riga > 0 Then Sheets("Foglio1").Cells(Riga, "I") = Sheets("Foglio2").Cells(X, "E").Value
    Next X
MsgBox "Fatto"
End Sub

[Anthony47]

Mi permetto di sconsigliare la semplificazione proposta, perchè in caso di errore il valore verrebbe scritto sull'ultima "Riga" calcolata correttamente.
La variante più semplice:

Codice: Seleziona tutto

        On Error Resume Next
        Riga = 0                                        '****AGGIUNTA QUI
        Riga = Application.Evaluate("LOOKUP(3,1/(Foglio1!C1:C1000=""" & Nome & """),ROW(C1:C1000))")
        If Riga > 0 Then Sheets("Foglio1").Cells(Riga, "I") = Sheets("Foglio2").Cells(X, "E").Value

[Ricky0185]

In questo sito la perfezione è l'obbiettivo dei mod.
Buona domenica