[Spirosgr]

Αντικαθιστούμε οποιονδήποτε παλαιότερο κώδικα, με αυτόν:

Const startHandicap As Byte = 8   'Γραμμή τίτλων στο φύλλο Αφετηρία
Const destHandicap  As Byte = 7    'Γραμμή τίτλων στον Προορισμό
Const destTitle     As String = "ΑΜ που δεν περάστηκαν"    'Τίτλος Προορισμού
Const WSHName       As String = "NotExists"  'Όνομα φύλλου ελέγχου

Sub TransferPlusSumData()
    Dim WSH         As Worksheet
    Dim Rng1        As Range
    Dim LrowStart   As Long
    Dim LrowDest    As Long
    Dim i           As Long
    Dim Mtch        As Long
    Dim iVL         As Variant

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    'Διαγράφει φύλλο με όνομα NotExists (Αν Υπάρχει)
    For Each WSH In ThisWorkbook.Worksheets
        If WSH.Name = WSHName Then WSH.Delete
    Next WSH

    Application.DisplayAlerts = True

    'Βάζει νέο φύλλο με όνομα NotExists
    Set WSH = ThisWorkbook.Sheets.Add _
              (After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    WSH.Name = WSHName
    WSH.Range("a1").Value = destTitle

    'Σετάρισμα & καθαρισμός περιοχών
    '1. Αφετηρία
    LrowStart = Sh0.Cells(Rows.Count, 1).End(xlUp).Row

    '2. Προορισμός
    LrowDest = sh1.Cells(Rows.Count, 2).End(xlUp).Row
    Set Rng1 = sh1.Range("b" & destHandicap + 1 & ":b" & LrowDest)

    For i = startHandicap + 1 To LrowStart
        iVL = Sh0.Range("a" & i).Value
        On Error Resume Next
        If iVL = 0 Then
            GoTo Blnc_Exect:
        Else
            GoTo Nrml_Exect:
        End If
Nrml_Exect:

        'Ψάχνει κοινούς ΑΜ στα φύλλα προορισμού

        On Error Resume Next
        Mtch = 0
        Mtch = Application.WorksheetFunction.Match(iVL, Rng1, 0)

        'Αν βρεθεί ΑΜ χωρίς προορισμό
        If Mtch = 0 Then

            'Τοποθετείται στο νέο φύλλο (μαζί με ημερομηνία = σήμερα)
            Dim Nr  As Long
            Nr = Sheets(WSHName).Cells(Rows.Count, 1).End(xlUp).Row + 1

            Sheets(WSHName).Range("a" & Nr).NumberFormat = "@"
            Sheets(WSHName).Range("a" & Nr).Value = Format(iVL, "@")

            Sheets(WSHName).Range("b" & Nr).Value = Format(Date, "dd/mmm/yyyy")

            With Sheets(WSHName).Columns("a:b")
                .WrapText = False
                .ShrinkToFit = False
                .MergeCells = False
                .EntireColumn.AutoFit
            End With
        End If

        'Μεταφορά δεδομένων στον προορισμό
        If Mtch <> 0 Then
            With sh1
                .Range("t" & Mtch + destHandicap).NumberFormat = "0.00"
                .Range("t" & Mtch + destHandicap).Value = Sh0.Range("k" & i).Value
                .Range("u" & Mtch + destHandicap).NumberFormat = "0.00"
                .Range("u" & Mtch + destHandicap).Value = Sh0.Range("m" & i).Value
                .Range("w" & Mtch + destHandicap).NumberFormat = "0.00"
                .Range("w" & Mtch + destHandicap).Value = Sh0.Range("o" & i).Value
                .Range("p" & Mtch + destHandicap).NumberFormat = "0.00"
                .Range("p" & Mtch + destHandicap).Value = Sh0.Range("t" & i).Value
                .Range("q" & Mtch + destHandicap).NumberFormat = "0.00"
                .Range("q" & Mtch + destHandicap).Value = Sh0.Range("aa" & i).Value
                .Range("r" & Mtch + destHandicap).NumberFormat = "0.00"
                .Range("r" & Mtch + destHandicap).Value = Sh0.Range("ag" & i).Value
                .Range("s" & Mtch + destHandicap).NumberFormat = "0.00"
                .Range("s" & Mtch + destHandicap).Value = Sh0.Range("ao" & i).Value
            End With

            'Πρόσθεση κελιών (στηλών που ορίζουμε)
            Dim Data_S As Double
            Dim Data_Y As Double
            Dim Data_AF As Double
            Dim Data_AN As Double

            With Sh0
                Data_S = .Range("s" & i).Value
                Data_Y = .Range("y" & i).Value
                Data_AF = .Range("af" & i).Value
                Data_AN = .Range("an" & i).Value
            End With

            Dim SumData As Double
            SumData = Application.WorksheetFunction.Sum(Data_S, Data_Y, Data_AF, Data_AN)

            With sh1
                If SumData = 0 Then
                    .Range("o" & Mtch + destHandicap).Value = vbNullString
                Else
                    .Range("o" & Mtch + destHandicap).NumberFormat = "0.00"
                    .Range("o" & Mtch + destHandicap).Value = SumData
                End If
            End With
        End If
Blnc_Exect:
    Next i
End Sub

Τα συγχωνευμένα κελιά, δεν είναι αποδεκτά
τόσο στην αφετηρία όσο και στον προορισμό.

Εφ όσον ο κώδικας, δεν καθαρίζει αυτόματα περιοχές (προορισμού),
ενδέχεται να προκύψουν σφάλματα.

Η μορφοποίηση των μεταφερόμενων αριθμών,
είναι ίδια με την μορφοποίηση της αφετηρίας (0,00)

Η μορφοποίηση των αθροισμάτων,
είναι ίδια με την μορφοποίηση της αφετηρίας (0,00)