Sub KH_Start()
Dim myR As Range
Dim myC As Integer, R As Integer
Dim C As Integer, CC As Integer, N As Integer, NN As Integer
Set myR = Range("base_T1")
myC = Feuil13.Range("H3").Value
'-----------------------------
'مواد الاربعة الاعمدة
For R = 1 To 4
C = Choose(R, 10, 14, 18, 31)
CC = Choose(R, 27, 28, 29, 34)
For N = 1 To 4
NN = Choose(N, 3, 4, 5, 7)
myR.Cells(myC, C + N - 1) = Cells(CC, NN)
Next
Next
'-----------------------------
'مواد الثلاث الاعمدة
For R = 1 To 7
C = Choose(R, 22, 25, 28, 35, 38, 44, 50)
CC = Choose(R, 30, 31, 32, 35, 36, 38, 40)
For N = 1 To 3
NN = Choose(N, 3, 4, 7)
myR.Cells(myC, C + N - 1) = Cells(CC, NN)
Next
Next
'-----------------------------
MsgBox "تم الترحيل"
End Sub