ترحيل بشرط لا توجد خلايا فارغة

[احمد عبدالحليم]

الملف المرفق يجب ان تكون جميع الخلايا تحتوى على قيم حتى يتم الترحيل واذا وجدت خلية او اكثر فارغة يرسل رسالة بانه توجد خلايا فارغة ويم تلوينها ويخرج من الكود دون ان يرحل البيانات

حتى يتم تعبئة الخلايا الفارغة ...

المشكلة الان انه يرحل وتوجد خلايا فارغة والمطلوب لا يرحل ويخرج من الماكرو حتى يتم تعبئتها

transfer.xlsm

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

1- العامود G يحتوي على معادلات لذلك لا يتعبر الكود خلاياه فارغة

2-لا حاجة الى كل هذا الحلقات التكرارية المدوبلة (على كل  خلية في كل صف و كل عامود لفحصها
    اذا كانت فارغة او لا)

3- الكود المطلوب (بشكل أفضل بدون حلقات تكرارية) 
   تم تغيير اسماء الصفحات الى اللغة الاجنبية (لحسن نسخ الكود ولصقه بدون مشاكل اللغة العربية)

Sub salim_cod()
Dim lrS%, lrM%
Dim S As Worksheet
Dim M As Worksheet
Dim S_rg As Range, Ful_rg As Range


Set S = Sheets("Source"): Set M = Sheets("MW")
lrS = S.Cells(Rows.Count, 1).End(3).Row
If lrS < 6 Then
   MsgBox "No Data To Transfer": Exit Sub
End If
S.Range("A6:F" & lrS).Interior.ColorIndex = xlNone
On Error Resume Next
Set S_rg = S.Range("A6:F" & lrS).SpecialCells(4)

If Not S_rg Is Nothing Then
S_rg.Interior.ColorIndex = 35
 MsgBox "You have Empty Cells": Exit Sub
End If
On Error GoTo 0

lrM = M.Cells(Rows.Count, 1).End(3).Row + 1
 M.Cells(lrM, 1).Resize(lrS - 5, 7).Value = _
 S.Range("A6:G" & lrS).Value
  Set Ful_rg = M.Range("a5").CurrentRegion
  If Ful_rg.Rows.Count > 1 Then
   Set Ful_rg = Ful_rg.Offset(1).Resize(Ful_rg.Rows.Count - 1)
    
    With Ful_rg
      .ClearFormats
      .Borders.LineStyle = 1
      .InsertIndent 1
      .Font.Bold = True
      .Font.Size = 14
      .Columns(1).NumberFormat = "dd/mm/yyy"
    End With
   End If
End Sub

الملف مرفق

 

 

Ahma_Halim.xlsm

[احمد عبدالحليم]

ايه الروعه والابداع دا

جزاك الله خيرا وجعله فى ميزان حسناتك

شكرا استاذنا الفاضل سليم حاصبيا

[احمد عبدالحليم]

استفسار اخير هل يمكن عمل عداد لتنفيذ الكود اذا رحلت البيانات مرحلة واحدة وبالخطاء رحلت نفس البيانات نفسها مره اخرى يخبرنى انه تم الترحيل سابقا

 

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

في نهاية الكود اضف هذا السطر كما في الصورة

بهذه الطريقة يقوم البرنامج بازالة التكرارات في الصفوف اوتوماتيكياً (دوت ان تشغر بذلك)

 

[احمد عبدالحليم]

شكرا وسلمت يداك استاذنا الفاضل سليم حاصبيا

[رشاد احمد]

اشكر الحاضر دائما استاذنا الكبير سليم وجزاك الله خير  وتمنياتى لك بالصحه والعافيه