السلام عليكم ورحمة الله تعالى وبراته
أخي احمد لقد اتعبتك معي جربت ما قلت لي لكن المشكلة ما تزال موجودة
على العموم ها هو الكود كما طلبت مني تعديله هل هو صحيح
Sub husalah()
Set FS = Sheets("الغيابات (2)")
Set TS = Sheets("الحوصلة")
ER = FS.UsedRange.Rows.Count
EC = FS.UsedRange.Columns.Count
TR = 5
For FR = 6 To ER
If FS.Cells(FR, 37) = False Then GoTo 3
RN = "A" & FR & ":E" & FR
FS.Range(RN).Copy
TS.Cells(TR, 1).PasteSpecial Paste:=xlPasteValues
TC = 7
For FC = 6 To EC - 1
Q1 = FS.Cells(FR, FC)
If Q1 = 0 Or Q1 = "" Then GoTo 4
TS.Cells(TR, TC) = Q1
TC = TC + 1
4 Next FC
TR = TR + 1
3 Next FR
Application.CutCopyMode = False
End Sub