تحميل اكسيل الى أكسيل أخر

[mohamed322]

لديا أكسيل متحول من الأوركل أريد أن أسحبه الى أكسيل أخر أوتومتيك عملت الكود ده بس المشكلة انة لازم أضعه فى نفس المكان أريد تعديله ليسحبه من أى مكان

Sub الأهلى()
'
' الأهلى Macro
'

'
    Sheets("البنك الأهلى").Select
    Workbooks.OpenText Filename:= _
        "E:\kokt\Private\test\محاولات\ترحيل\البنك الأهلى.xls", Origin:=1256, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
        16, 1), Array(17, 1), Array(18, 1)), TrailingMinusNumbers:=True
    Cells.Select
    Selection.Copy
    Windows("نهائى الصوافى.xls").Activate
    Cells.Select
    ActiveSheet.Paste
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2:G2").Select
    Selection.Copy
    Range("H1").Select
    ActiveSheet.Paste
    Columns("A:G").Select
    Range("G1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("M9").Select
    Columns("G:G").EntireColumn.AutoFit
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = True
    Columns("D:D").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("A:A").EntireColumn.AutoFit
    Range("L8").Select
    ActiveWindow.SmallScroll Down:=6
End Sub

 

 

[mohamed322]

هل لديها حل