manlook

شكرا استاذنا انا استقدتا من الكود الترحيل ممكن طلب لو امكن Sub TOTAL() Dim d As Integer, x As Integer Dim i As Byte Range("a1:n20000") = "" For i = 2 To Worksheets.Count If UCase(Sheets(i).Name) <> "Summary" Then d = Sheets("Summary").Range("a" & Rows.Count).End(xlUp).Row With Sheets(i) x = .Range("a" & Rows.Count).End(xlUp).Row .Range("a1:n" & x).Copy Sheets("Summary").Range("a" & d + 1) End With End If Next Sheets("Summary").Select End Sub ان النسخ يكون بالقيم فقط لانو بينسخ المعادلات شاكر ليك مجهودك المتميز