با سلام و خسته نباشید خدمت شما من توضیحات کامل رو در فایل پیوست نوشتم
ممنون میشم کمکم کنید.
					ممنون میشم کمکم کنید.
Sub m_excel()
Dim i, n, lstr As Long
lstr = Cells(Rows.Count, 6).End(3).Row
For i = 1 To lstr
    If Cells(i, 1) = Range("a5") Then
        For n = Cells(i + 1, 1).Row To Cells(i + 1, 2).End(xlDown).Row
            Cells(n, 7) = Cells(i - 2, 4)
            Cells(n, 8) = Cells(i - 3, 5)
        Next
    End If
Next
Range("g1:g" & lstr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A:A,C:C,E:E,F:F").EntireColumn.Delete
End Sub
کامنت