اضافة سطر فارغ

[nany4mg]

الاخوة الاعزاء عندي مشكلة عويصة بقالي اسبوع مش قادر احلها عندي بيان به صفوف كثيرة واحتاج ان اضيف سطر فارغ بعد كل رقم مكرر بحيث اقوم بجمع الاقام المكررة في البيان وارسل اليكم عينة من المطلوب عمله واتمني ان يرد عليا احد بالجواب 

MMMM.xlsm

[Ali Mohamed Ali]

تفضل يمكنك استخدام هذا الكود

Sub AddBlankRows()
Dim iRow As Integer, iCol As Integer
Dim oRng As Range
Set oRng = Range("b1")
iRow = oRng.Row
iCol = oRng.Column
Do
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
    Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
    iRow = iRow + 2
Else
    iRow = iRow + 1
End If
Loop While Not Cells(iRow, iCol).Text = ""
End Sub

MM.xlsm

[nany4mg]

الاساتذة الكرام 

عندي ملف اواجه به مشكلة كبيرة الا وهي الملف مكون من 40 الف ريكورد محتاج ان اضيف سطر قبل 

Pack Qty

كما في الملف المرفق على اساس انني اقدر ان اطبق  

CONSALIDATE  اتمنى حد يساعدني ضروري 

Book2.xlsx

[سليم حاصبيا]

جرب هذا الماكرو

Option Explicit
Sub add_row()
    Dim My_sh As Worksheet
    Dim mot$, Ro1, Ro2
    Dim All_rg As Range
    Dim rg As Range, Find_rg As Range

Set My_sh = Sheets("Sheet1")
mot = "Pack Qty"
Set rg = My_sh.Range("G:G")
Set Find_rg = rg.Find(mot, lookat:=1)

If Not Find_rg Is Nothing Then
  Ro1 = Find_rg.Row: Ro2 = Ro1
  Do
      If All_rg Is Nothing Then
       Set All_rg = Find_rg
       Else
       Set All_rg = Union(All_rg, Find_rg)
      End If
           Set Find_rg = rg.FindNext(Find_rg)
       Ro2 = Find_rg.Row
       If Ro2 = Ro1 Then Exit Do
 Loop
 If Not All_rg Is Nothing Then
    Set All_rg = All_rg.Offset(1)
    All_rg.EntireRow.Insert
  End If
End If
End Sub

الملف مرفق

 

nany4mg.xlsm

[nany4mg]

استاذي العزيز الكود مشتغلش حضرتك انا بعت ملف به الداتا المطلوبة احتاج ان اعمل CONSALIDATE لكل رقم اذن على حدى لكي يقوم بجمع كل 

Item no

Pack Qty

 

كما في الملف المرفق والداتا كما ترى حضرتك كثيرة جدا فهل من طريقة اسرع للقيام بالحساب اشكر سعادتك 

Book2.xlsx