طلب تعديل على كود نسخ ولصق عن طريق vba

[wissamkh]

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

لدي هذا الكود لترحيل بيانات من خلية الى خلية اخرى

وأستعمله لعدة خلايا

أريد تعديل الكود أنه بحال كانت خلية من الخلايا المرحلة فارغة يتم تعبئتها تلقائيا بأي نص

حتى لا تتداخل بيانات الاسطر في الترحيل التالي.

وشكرا لكم 

Sheets("sheet1").Select
    Range("G8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("D" & Sheets("sheet2").[D1000].End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 

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

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

Option Explicit
Sub copy_paste()
Dim lr1%: lr1 = Sheets("Sheet1").Cells(Rows.Count, "D").End(3).Row + 2
lr1 = IIf(lr1 = 3, 1, lr1)
Dim lr2%: lr2 = Sheets("Sheet2").Cells(Rows.Count, "D").End(3).Row
Dim i%: i = 1
Dim col As Object
Set col = CreateObject("System.Collections.ArrayList")
 With col
    Do Until i > lr2
      If Sheets("Sheet2").Range("D" & i) <> vbNullString Then
      .Add Sheets("Sheet2").Range("D" & i).Value
      End If
     i = i + 1
    Loop
     Sheets("Sheet1").Range("d" & lr1).Resize(.Count - 1) = _
    Application.Transpose(.toarray)
  End With
End Sub

الملف مرفق

 

Bookaa.xlsm

[wissamkh]

شكرا لك أخ سليم على المساعدة القيّمة.

[wissamkh]

عذرا أخي لم أفهم الكود جيدا

أخي هذا الملف المرفق هو نموذج عن ما أعمل به

ال sheet1  الخلاية اللي محددة هي التي سوف ترحل الى الصفحة الثانية

أريدها بحال كانت فارغة عند الترحيل، تلقائيا يكتب أي شيء مكانها في صفحة الترحيل في المكان المخصص لها

boooookk.xlsm

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

كيف تريدني ان اعمل على جدول فارغ تماماً

[wissamkh]

أخي يمكنك تعبئة الخلاية المحددة بما تشاء، فهي الخلايا التي سترحل الى الصفحة الثانية

عند الضغط على save as pdf سوف ترحل الخلايا

تم تعديل يناير 19, 2019 بواسطه wissamkh

[wissamkh]

للرفع

 

تم التعديل على الملف وتم وضع سطرين لتجربة الحالة المطلوبة

في الشيت 2  السطر الأول بالجدول هو في حال كانت جميع الخلايا المرحلة من الشيت 1 ذات محتوى نص معين

أما السطر الثاني هو في حال كانت بعض الخلايا فارغة

 

لا أريدها عندما تترحل الى الجدول في الشيت 2 أن تبقى فارغة، أريد تعبئتها بأي نص أو رمز

boooookk.xlsm