طريقة اضافة كود نسخ خلية من الشيت المرحل الى شيت خلية فى شيت ادخال البيانات

[عبده الطوخى 1970]

السادة الافاضل 

ارجو سعة صدركم بما اطلب وان شاء الله اجد الاجابة لديكم كما تعودنا من خبراء هذا المنتدى 

المطلوب 

نسخ الخلية AB3 من اليوم المرحل الى الخلية C3 من شيت ادخال البيانات 

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

لقد جربت كافة المعادلات وبائت بالفشل 

ومرفق الملف 

 

بيان السولار اليومى لمزارع الامهات - Copy.xlsm

[أبوأحـمـد]

ضع هذا الكود قبل رسالة تم الترحيل

'نقل الرصيد الحالي من الجدول2
' إلى رصيد سابق في الجدول1
 Dim i As Integer
For i = 3 To 10
wk.Range("c" & i) = wk.Range("AB" & i)
Next
''''''''''''''''''''''''''

 

[عبده الطوخى 1970]

استاذنا الفاضل أبوأحـمـد

لقد اجتهدنا بالعمل على الكود الاصلى الذى سبق انك عملته 

واذا كان هناك تعديل او تصحيح نرجو اعطاء خبرتك 

Sub TR7el()
Dim namsh As String
Dim wk, wk2 As Worksheet
Dim check As Boolean

namsh = Format(ورقة1.Range("A3"), "yyyy-mm-dd")
Set wk = Worksheets("ادخال البيانات")
   If namsh = Empty Then
   Beep
   MsgBox "لا يوجد يوم ", , "عفوا"
wk.Range("A3").Select

   Exit Sub

End If

For Each wk2 In Worksheets
If wk2.Name Like namsh Then check = True: Exit For
Next
If check = True Then
MsgBox "تم ترحيل هذا اليوم مسبقا", , "عفوا"
Exit Sub
End If
       
    With ThisWorkbook
        .Sheets.Add(Before:=.Sheets(.Sheets.Count)).Name = namsh
    End With
Set wk2 = Worksheets(namsh)
wk.Range("U2:AD10").Copy
wk2.Range("A2").PasteSpecial Paste:=xlPasteValues
wk2.Range("A2").PasteSpecial Paste:=xlPasteFormats
wk2.Range("h3:h10").Copy
wk.Range("c3:c10").PasteSpecial Paste:=xlPasteValues
wk2.Rows(2).RowHeight = 35
wk2.Rows("3:10").RowHeight = 25
wk2.Columns(1).ColumnWidth = 10
wk2.Columns(2).ColumnWidth = 7
wk2.Columns(3).ColumnWidth = 8
wk2.Columns(4).ColumnWidth = 8
wk2.Columns(5).ColumnWidth = 8
wk2.Columns(6).ColumnWidth = 8
wk2.Columns(7).ColumnWidth = 8
wk2.Columns(8).ColumnWidth = 8
wk2.Columns(9).ColumnWidth = 8
wk2.Columns(10).ColumnWidth = 8
MsgBox "تم الترحيل "
wk.Activate
SendKeys "{F2}"
wk.Range("A3").Select
wk.Range("A3") = Date
wk.Range("A3") = ""
'wk.Range("e3:e10") = 0
'wk.Range("d3:d10") = 0
SendKeys "{ENTER}"

End Sub