ایجاد ردیف وMergeباسلول ردیف قبل

**M_ExceL** · 2020/11/08, 19:19

نوشته اصلی توسط habib100

با سلام و خسته نباشید
فایل اکسلی دارم که می خواهم در ابتدا یک ردیف زیر هر ردیف اجاد شود و سپس با سلول بالا یی آن داده Merge شود.
فایل نمونه را هم قرار داده ام.
ممنون

سلام،

کد:

Sub M_ExceL()

Dim End_Row, Row_Counter As Long
    
Dim CelValue As Variant

        End_Row = (Cells(Rows.Count, 1).End(3).Row * 2)
        
        Row_Counter = 2
        
        Do
        
            CelValue = Cells(Row_Counter, 1).Value
            
            Cells((Row_Counter + 1), 1).EntireRow.Insert
            
            Range(Cells(Row_Counter, 1), Cells((Row_Counter + 1), 1)).Merge
            
            Range(Cells(Row_Counter, 2), Cells((Row_Counter + 1), 2)).Merge
            
            Row_Counter = Row_Counter + 2
        
        Loop While Row_Counter <> End_Row

End Sub