اذهب الي المحتوي
أوفيسنا

بيانات من خلية الى اخرى


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

17 دقائق مضت, سليم حاصبيا said:

هات مثال غلى ذلك

ثم تريد النسخ ام النقل

السلام عليكم 

تفضل

 

 

 

 

 

 

 

انتقال بيانات من الى (0).zip

تم تعديل بواسطه حسين22
رابط هذا التعليق
شارك

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
If Target.Count > 1 Or Target <> "" Then Exit Sub
    If Target.Offset(0, 1) <> "" And Target.Offset(0, 2) = "" Then
        Target.Value = Target.Offset(0, 1).Value
        Target.Offset(0, 1).Value = ""
        Target.Offset(0, 2).Value = Time
        Target.Offset(0, 3).Value = Date
    End If
End Sub

 

  • Like 1
رابط هذا التعليق
شارك

30 دقائق مضت, سليم حاصبيا said:

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


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
If Target.Count > 1 Or Target <> "" Then Exit Sub
    If Target.Offset(0, 1) <> "" And Target.Offset(0, 2) = "" Then
        Target.Value = Target.Offset(0, 1).Value
        Target.Offset(0, 1).Value = ""
        Target.Offset(0, 2).Value = Time
        Target.Offset(0, 3).Value = Date
    End If
End Sub

 

شكرا يا استا.د ساجرب

جزاك الله خيرا يا استاد الماكرو يعمل فقط سازيل كود ادراج التوقيت 

هل يمكن تتطبيقه على اكتر من شيت بنفس

الجد ول  وتشغيله بctrl +d بعد التحديد 

واعتدر عن الازعاج 

 

 

  • Like 1
رابط هذا التعليق
شارك

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

اخ سليم حاصبيا هل من طريقة لتطبيق هذا الماكرو على اكثر من شيت وتفعيله ب ctrl+d بعد تحديد خلية؟ 

تم تعديل بواسطه حسين22
رابط هذا التعليق
شارك

تفضل اخي ما تريد

يمكنك تشغيل الماكرو بواسطة Ctlr+Shif+D وليس Crl+D  لان هذا الاختصار يفقدك اختصار اخر (نسخ المعادلات)

يمكنك ايضاً تشغيل الماكرو بواسطة الزر

 

 

انتقال بيانات من الى Macro1.rar

  • Like 1
رابط هذا التعليق
شارك

السلام عليكم 

استادي الماكرو يعمل عكس ما اريد 

قمت بتحديد خلية a2وشغلت الماكرو ونقل جميع بيانات العمودb

انا اريد تحديدخلية او اثنين مثلا  وينقل بياناتهما  ب ctrl+chft+d فقط  ان كان ممكنا 

وشكرا 

تم تعديل بواسطه حسين22
رابط هذا التعليق
شارك

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

Sub experement()
Dim my_rg As Range
On Error Resume Next
    Set my_rg = Application.InputBox("insert you range", Type:=8)
    If my_rg Is Nothing Then
         MsgBox ("Please select One column")
         On Error GoTo 0
        Exit Sub
    End If
cols = my_rg.Columns.Count
If cols <> 1 Then MsgBox ("Please select One column"): Exit Sub
    If my_rg.Count = 1 Then
        Set my_rg = my_rg
        Else
        Set my_rg = my_rg.SpecialCells(xlCellTypeBlanks).Columns(1)
    End If
  For Each cel In my_rg
        With cel
               If .Offset(0, 1).Value <> "" Then
                  .Value = .Offset(0, 1).Value
                  .Offset(0, 1).Value = ""
                  .Offset(0, 2).Value = Date
               End If
        End With

  Next

End Sub

 

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
×
×
  • اضف...

Important Information