مساعدة في ترحيل بيانات من شيت اكسيل إلى شيت آخر

[سعيد 1428]

الإخوة الكرام 

السلام عليكم ورحمة الله 

في الملف المرفق اريد المساعدة في ترحيل البيانات من شيت إدخال الحجز إلى شيت DATA ومن ثم يتم حذف البيانات في شيت الحجز 

ملاحظة : تم وضع إطار ملون على البيانات المراد ترحيلها 

وشكرا 

TARHIL.xlsx

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

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

Option Explicit
Sub Tarhil_Data()
Dim my_rg_1 As Range
Dim my_rg_2 As Range
Dim my_rg_1_part_1 As Range
Dim my_rg_2_part_1 As Range
Dim My_Num: My_Num = Sheets("REZ").[c6]

If Not IsError(Application.Match(My_Num, Sheets("DATA") _
.Range("B:B"), 0)) Or My_Num = vbNullString Then
  MsgBox "the Res.Number is allready Exist" & Chr(10) & "Or" _
  & Chr(10) & " Res.Number is Empty " & _
  Chr(10) & Chr(10) & "I can't transfere the Data", 64
  Exit Sub
End If
 
Dim x1%, x2%, lr%
lr = Sheets("DATA").Cells(Rows.Count, "D").End(3).Row + 1
x1 = Application.Match(0, Sheets("REZ").Range("H14:H18"), 0)
x2 = Application.Match(0, Sheets("REZ").Range("H22:H26"), 0)
  With Sheets("REZ")
    Set my_rg_1 = .Range("B14:I" & x1 + 12)
    Set my_rg_2 = .Range("B22:I" & x2 + 20)
    Set my_rg_1_part_1 = .Range("B14:G" & x1 + 12)
    Set my_rg_2_part_1 = .Range("B22:G" & x2 + 20)
 End With

  With Sheets("DATA")
    .Range("B" & lr) = Sheets("REZ").Range("c6")
    .Range("C" & lr) = Sheets("REZ").Range("c7")
    .Range("D" & lr).Resize(my_rg_1.Rows.Count, 8).Value = my_rg_1.Value
  End With
lr = lr + my_rg_1.Rows.Count
Sheets("DATA").Range("D" & lr).Resize(my_rg_2.Rows.Count, 8).Value = my_rg_2.Value
my_rg_1_part_1.ClearContents: my_rg_2_part_1.ClearContents
Sheets("REZ").[c6:c7].ClearContents
    Set my_rg_1 = Nothing: Set my_rg_2 = Nothing
    Set my_rg_1_part_1 = Nothing
    Set my_rg_2_part_1 = Nothing
End Sub

الملف مرفق

 

My_TARHIL.xlsm

[سعيد 1428]

أخي سليم 

أشكركم على المبادرة الطيبة 

عند تجربة الكود لاحظت أنه يقوم برتحيل بعض الصفوف فقط كما يقوم بحذف عناوين الاعمدة 

وقد قمت بإضافة عمود في الوسط وهو عمود عدد الغرفة 

وعليه آمل منكم مراجعة الكود مرة أخرى حتى يتم ترحيل البيانات المحاطة بالإطار الملون بشكل صحيح

وشكرا 

My_TARHIL.xlsm

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

الكود يقوم بترحيل البيانات التي تحتوي على معلومات من البيانات المحاطة بالإطار الملون (يتحاشى الاصفار)

في المثال الذي ارسلته سطرين من كل مجموعة

جرب كتابة اكثر من سطرين و سترى النتيجة

[سعيد 1428]

عند تنفيذ امر الترحيل يعطي الراسالة التالية 

Type mismach

[سعيد 1428]

السلام عليكم 

في الملف المرفق اريد ترحيل البيانات من شيت rez إلى شيت data

أريد تعديل الماكرو بحيث لا يتم ترحيل ( رقم الحجز واسم العميل ) إلا بعدد الصفوف التي فيها بيانات في المربع الخاص بتفاصيل الحجز 

وشكرا 

TARHIL.xlsm