خودم حلش کردم ممنون از همه
کد:
Sub ReportStaf()
Dim lr, lr1, i As Integer
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
lr1 = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
lr = 1
For i = 4 To 305
If Val(ws.Range("AB" & i)) = lr Then
Sheets("TopNMoshtari").Range("AH" & i) = Str(lr)
lr = lr + 1
lr1 = i
For j = i To lr1 + 14
If Val(ws.Range("AE" & j)) = 1 Then
Sheets("TopNMoshtari").Range("AI" & i) = Sheets("TopNMoshtari").Range("K" & j)
Sheets("TopNMoshtari").Range("AJ" & i) = Sheets("TopNMoshtari").Range("I" & j)
Sheets("TopNMoshtari").Range("AK" & i) = Sheets("TopNMoshtari").Range("F" & j)
Sheets("TopNMoshtari").Range("AL" & i) = Sheets("TopNMoshtari").Range("D" & j)
End If
Next j
Else
Sheets("TopNMoshtari").Range("AH" & i) = Str(Sheets("TopNMoshtari").Range("AH" & i))
End If
Next i
Next ws
End Sub
علاقه مندی ها (Bookmarks)