اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

Required code

Option Explicit

Sub Get_All()
  Dim sh1 As Worksheet
  Dim sh2 As Worksheet
  Dim LR1 As Single, LR2 As Single
  Dim m As Single, t As Single, x As Single

  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  LR1 = sh1.Cells(Rows.Count, 2).End(3).Row
  LR2 = sh2.Cells(Rows.Count, 1).End(3).Row
m = 2
   If LR1 > 1 Then
     Union(sh1.Range("B2:B" & LR1), _
     sh1.Range("D2:D" & LR1)).ClearContents
   End If
For x = 2 To LR2
    If sh2.Cells(x, 2).MergeCells Then
      t = sh2.Cells(x, 2).MergeArea.Rows.Count
          With sh1.Cells(m, 2)
           .Value = sh2.Cells(x, 2)
           .Offset(, 2) = sh2.Cells(x, 4)
          End With
       x = x + t - 1: m = m + 1
    Else
          With sh1.Cells(m, 2)
            .Value = sh2.Cells(x, 2)
            .Offset(, 2) = sh2.Cells(x, 4)
          End With
      m = m + 1
   End If
Next
End Sub

الملف مرفق

Naser.xlsm

  • Like 2
  • تمت الإجابة
قام بنشر

تم التعديل

Option Explicit

Sub GetMe_All()
  Dim sh1 As Worksheet
  Dim sh2 As Worksheet
  Dim LR1 As Single, LR2 As Single
  Dim m As Single, t As Single, x As Single

  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  LR1 = sh1.Cells(Rows.Count, 2).End(3).Row
  LR2 = sh2.Cells(Rows.Count, 1).End(3).Row
m = 2
   If LR1 > 1 Then
     Union(sh1.Range("A2:A" & LR1), sh1.Range("B2:B" & LR1), _
     sh1.Range("D2:D" & LR1)).ClearContents
   End If
For x = 2 To LR2
    t = sh2.Cells(x, 2).MergeArea.Rows.Count
          With sh1.Cells(m, 2)
           .Offset(, -1) = "From " & x - 1 & " To " & t + x - 2
           .Value = sh2.Cells(x, 2)
           .Offset(, 2) = sh2.Cells(x, 4)
          End With
       x = x + t - 1
    m = m + 1
Next
End Sub

الملف من جديد

 

Naser_1.xlsm

  • Like 2

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information