بوحميد
مبرمج مبدع
- التسجيل
- 22 يونيو 2003
- المشاركات
- 532
و هذا كود الماكرو النهائي للمهتم
و اللي عنده فكره أو إقتراح بخصوص التطوير لا يبخل علينا
و اللي عنده فكره أو إقتراح بخصوص التطوير لا يبخل علينا
كود:
Sub CMWW()
'
' CMWW Macro
' On 4/5/2006 byِِ ِAM
'
' Keyboard Shortcut: Ctrl+a
'
Columns("G:N").Select
Range("N1").Activate
Selection.Delete Shift:=xlToLeft
Range("G1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Close"
Sheets("Sheet2").Select
Range("A2:F10").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A168").Select
ActiveSheet.Paste
Columns("B:B").ColumnWidth = 8
Range("C147").Select
Columns("B:B").ColumnWidth = 10.29
Columns("C:C").ColumnWidth = 9.86
Columns("D:D").ColumnWidth = 6.86
Columns("D:D").ColumnWidth = 10.43
Columns("E:E").ColumnWidth = 8.14
Columns("E:E").ColumnWidth = 9.29
Range("A168").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "INDEX"
Range("A175").Select
ActiveCell.FormulaR1C1 = "FOODS"
Range("A168:A176").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=10
Range("A177").Select
ActiveSheet.Paste
Range("A177").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "INDEXw"
Range("A178").Select
ActiveCell.FormulaR1C1 = "BANKINGw"
Range("A179").Select
ActiveCell.FormulaR1C1 = "INVESTMENTw"
Range("A180").Select
ActiveCell.FormulaR1C1 = "INSURANCEw"
Range("A181").Select
ActiveCell.FormulaR1C1 = "REAL ESTATEw"
Range("A182").Select
ActiveCell.FormulaR1C1 = "INDUSTRIALw"
Range("A183").Select
ActiveCell.FormulaR1C1 = "SERVICESw"
Range("A184").Select
ActiveCell.FormulaR1C1 = "FOODSw"
Range("A185").Select
ActiveCell.FormulaR1C1 = "NON KUWAITIESw"
Columns("A:A").Select
Range("A157").Activate
Selection.ColumnWidth = 17
Selection.ColumnWidth = 19.57
Sheets("Sheet2").Select
Range("J2:M10").Select
Selection.Copy
Sheets("Sheet1").Select
Range("B177").Select
ActiveSheet.Paste
Range("F168:F176").Select
ActiveWindow.SmallScroll ToRight:=3
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("F177").Select
ActiveSheet.Paste
Range("F189").Select
On Error Resume Next
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
Worksheets.Application.Range("G2:G185") = Format(Date, "short Date")
On Error Resume Next
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
End Sub
