ترحيل عمودي

[unknown]

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

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

ترحيل دوامات اعمال.xlsm

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

ريما ينفع هذا الكود

Sub Salim_Code()
Dim Source As Worksheet: Set Source = Sheets("دوامات")
Dim x$: x = Source.Range("b2")
Dim Target_sh As Worksheet: Set Target_sh = Sheets(x)
Dim last_row%: last_row = Application.CountA(Source.Range("a:a")) - 1

 If last_row = 1 Then last_row = 5
Dim k%, laste_col_source%, laste_col_target%
   For k = 1 To 500
    If Source.Cells(5, k) = vbNullString Then Exit For
   Next
     laste_col_source = k - 1: k = 0
     
  For k = 1 To 500
    If Target_sh.Cells(1, k) = vbNullString Then Exit For
   Next
 laste_col_target = k: k = 0
 Target_sh.Cells(1, laste_col_target).Resize(last_row + 1, 1).Value = _
 Source.Cells(5, laste_col_source).Resize(last_row + 1, 1).Value
End Sub

الملف مرفق

 

ترحيل اعمال.xlsm

[unknown]

شكرا لك اخي وجزاك الله خيرا