تفضل اخى الكريم
Option Explicit
Sub Transfer_Non_Adjacent_Columns_Using_Arrays_YasserKhalil_ExcelEgy()
'Code by MR.Yasser Khalil
'From page https://www.excel-egy.com/forum/t3892
Dim WB As Workbook, WS As Worksheet, SH As Worksheet
Dim arr As Variant, i As Variant, cr As Variant, j As Long
Dim LR As Long
Set SH = ThisWorkbook.Worksheets("ترحيل يومية")
Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "العملاء.xlsm")
Set WS = WB.Worksheets(SH.Range("D2").Value)
arr = SH.Range("A5:F" & SH.Cells(Rows.Count, 1).End(xlUp).Row).Value2
cr = Array(8, 9, 10, 11, 12, 4)
LR = WS.Cells(Rows.Count, 11).End(xlUp).Row + 1
For Each i In Array(1, 2, 3, 4, 5, 6)
WS.Cells(LR, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i)
j = j + 1
Next i
WS.Range("K:K").NumberFormat = "[$-1010000]yyyy/mm/dd;@"
WB.Close Savechanges:=True
End Sub