دمج ثلاثه اكواد

[أيهاب ممدوح]

يوجد كود 

قمت بعمل استدعاء لكود اخر عن طريق CALL

وقمت بعمل استدعاء كود اخر ثالث عن طريق CALL

لكن كود يعمل وكود لا يعمل

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

جرب هذه الملف

 

Three_cdes_in One.xlsm

[أيهاب ممدوح]

اخي الكريم 

لا يعمل الكود الثالث

الكود الاول

Sub ehab1()
Dim my_sh As Worksheet: Set my_sh = Sheets("سندات القبض")
Dim Sanad As Worksheet: Set Sanad = Sheets("سند قبض")
X = my_sh.Cells(Rows.Count, 2).End(xlUp).Row + 1
With my_sh.Range("a" & X)
'.Value = Sanad.[d5].Value
.Offset(0, 1).Value = Sanad.[h4].Value
.Offset(0, 2).Value = Sanad.[d5].Value
.Offset(0, 3).Value = Sanad.[g7].Value
.Offset(0, 4).Value = Sanad.[e7].Value
.Offset(0, 5).Value = Sanad.[c7].Value
.Offset(0, 6).Value = Sanad.[a7].Value
.Offset(0, 7).Value = Sanad.[d10].Value
.Offset(0, 8).Value = Sanad.[a10].Value
.Offset(0, 9).Value = Sanad.[i9].Value
.Offset(0, 10).Value = Sanad.[i12].Value
.Offset(0, 11).Value = Sanad.[i13].Value
.Offset(0, 12).Value = Sanad.[i14].Value
.Offset(0, 13).Value = Sanad.[i15].Value
.Offset(0, 14).Value = Sanad.[i16].Value
End With
 With Sanad
   
      'MsgBox ("تم الحفظ")
      
End With
copy_data_Salim
tahwiell
End Sub

الكود الثاني

Sub copy_data_Salim()
Dim My_Sheet As Worksheet
Set My_Sheet = Sheets("سندات القبض")
Dim Target_Sh As Worksheet
If ActiveSheet.Name <> My_Sheet.Name Then GoTo Exit_Me
Dim laste_row%
Dim Const_Srting$: Const_Srting = "تم الترحيل"
Dim k%, m%, i%, t%
Dim Source_Array()
ReDim Source_Array(1 To 11)
 Source_Array = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "N")
 Dim Target_Array()
 ReDim Target_Array(1 To 11)
 Target_Array = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")

k = My_Sheet.Cells(Rows.Count, 2).End(3).Row
On Error Resume Next
For i = 2 To k
  m = My_Sheet.Cells(i, Columns.Count).End(1).Column
  If My_Sheet.Cells(i, "q") = Const_Srting Then GoTo Next_I
   Set Target_Sh = Sheets(My_Sheet.Cells(i, "P") & "")
    laste_row = Target_Sh.Cells(Rows.Count, 3).End(3).Row + 1
     For t = LBound(Source_Array) To UBound(Source_Array)
        Target_Sh.Cells(laste_row, Target_Array(t)) = _
        My_Sheet.Cells(i, Source_Array(t))
     Next

   My_Sheet.Cells(i, "Q") = Const_Srting

Next_I:
Next
Exit_Me:
Erase Source_Array: Erase Target_Array

    Application.ScreenUpdating = True
End Sub

الكود الثالث

Sub tahwiell()
'نقل البيانات
Application.Calculation = xlManual
Dim FS, FR, TS, TR
FS = "سند قبض"
FR = "a10"
TS = Sheets(FS).Range("A7")
TR = Sheets(FS).Range("i26")
Sheets(FS).Range(FR).Copy
Sheets(TS).Range(TR).PasteSpecial Paste:=xlPasteValues

Application.Calculation = xlAutomatic

    ActiveSheet.EnableSelection = xlUnlockedCells
   



End Sub

 

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

الكود الثالث يكتب هكذا

Sub tahwiell()

Application.Calculation = xlManual
Dim FS, FR, TS, TR
FS = "سند قبض"
FR = "a10"
TS = Sheets(FS & "").Range("A7")
TR = Sheets(FS & "").Range("i26")
Sheets(FS & "").Range(FR & "").Copy
TS = Sheets(FS & "").Range(TR & "").PasteSpecial(Paste:=xlPasteValues)
 Application.Calculation = xlAutomatic
    ActiveSheet.EnableSelection = xlUnlockedCells
  

End Sub

 

[أيهاب ممدوح]

الكود الاول 

يقوم باستدعاء الكودين الثاني والثالث 

الثالث اسمه تحويل يعمل جيدا

المشكله في الكود الثاني لا يعمل مع الاستدعاء من خلال الكود الاول

ولكنه يعمل منفصل

[أيهاب ممدوح]

الكود الثاني فيه سطر 

If ActiveSheet.Name <> My_Sheet.Name Then GoTo Exit_Me