ترحيل بيانات من خلايا مختلفه من ملفات الى ملف واحد مع كتابة الملاحظات التى تخص ترحيل البيانات

Sub Test()

    Dim x, wb As Workbook, wbRevision As Workbook, wbClient As Workbook, ws As Worksheet, sh As Worksheet, f As Boolean, c As Range, sTemp As String, sBill As String, t1 As Double, t2 As Double, t3 As Double

    Application.ScreenUpdating = False

        Set wbRevision = ThisWorkbook

        Set sh = wbRevision.Worksheets(1)

        For Each wb In Application.Workbooks

            If wb.Name <> wbRevision.Name Then f = True: Set wbClient = wb: Exit For

        Next wb

        If f = False Then MsgBox "Open The Client Workbook", vbExclamation: Exit Sub

        Set ws = wbClient.Worksheets(1)

        sBill = vbNullString: t1 = 0: t2 = 0: t3 = 0

        If Application.CountA(ws.Columns("N")) > 0 Then

            For Each c In ws.Columns("N").SpecialCells(xlCellTypeFormulas).Cells

                sTemp = vbNullString

                sTemp = "فاتورة رقم " & c.Offset(, -9).Value & " بتاريخ " & Format(c.Offset(, -7).Value, "yyyy/mm/dd") & " بمبلغ " & Application.WorksheetFunction.Round(c.Value, 1) & " لا يوجد لها فاتورة"

                sBill = sBill & IIf(sBill <> "", " - ", "") & sTemp

                t1 = t1 + Application.WorksheetFunction.Round(c.Value, 1)

            Next c

        End If

        If Application.CountA(ws.Columns("O")) > 0 Then

            For Each c In ws.Columns("O").SpecialCells(xlCellTypeConstants).Cells

                sTemp = vbNullString

                sTemp = "فاتورة رقم " & c.Offset(, -10).Value & " بتاريخ " & Format(c.Offset(, -8).Value, "yyyy/mm/dd") & " لم يخصم نسبة التعاقد بمبلغ " & c.Value

                sBill = sBill & IIf(sBill <> "", " - ", "") & sTemp

                t2 = t2 + c.Value

            Next c

        End If

        If Application.CountA(ws.Columns("P")) > 0 Then

            For Each c In ws.Columns("P").SpecialCells(xlCellTypeFormulas).Cells

                sTemp = vbNullString

                sTemp = "فاتورة رقم " & c.Offset(, -11).Value & " بتاريخ " & Format(c.Offset(, -9).Value, "yyyy/mm/dd") & " بمبلغ " & Application.WorksheetFunction.Round(c.Value, 1) & " يوجد ملاحظة × على كامل الفاتورة"

                sBill = sBill & IIf(sBill <> "", " - ", "") & sTemp

                t3 = t3 + Application.WorksheetFunction.Round(c.Value, 1)

            Next c

        End If

        With sh

            x = Application.Match(Val(Split(wbClient.Name, ".")(0)), .Columns(1), 0)

            If Not IsError(x) Then

                .Cells(x, 5).Resize(, 4).Value = Array(IIf(t3 = 0, Empty, t3), IIf(t2 = 0, Empty, t2), IIf(t1 = 0, Empty, t1), sBill)

                Application.Goto .Cells(x, 1), True

                MsgBox "Done Successfully", 64, "YasserKhalil Excel-Egy"

            End If

        End With

    Application.ScreenUpdating = True

End Sub