LinkBack URL
About LinkBacksI am looking to write a macro that will save the file (1.xls) in a
specific directory when running. The Macro works well, but if I open an
other file (2.xls) in other Directory, my Macro saves the file in that
Directory.
Here is an example of my Macros:
Sub OK_sttt()
'
' INREG stttV LIST Macro
' Macro recorded 20.03.2006 by emil
'
Workbooks.Open Filename:="E:\SERVIM\livrari dupa inventar\Stoc timp
real.xls"
Windows("Stoc timp real.xls").Activate
Rows("2:15").Select
Selection.Insert Shift:=xlDown
Selection.RowHeight = 18
Windows("sttt.xls").Activate
Range("D13:D26").Select
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("K2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("I13:I26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.SmallScroll ToRight:=41
Range("AV2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("J13:J26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.SmallScroll ToRight:=-25
Range("AB2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("M13:M26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.Panes(3).Activate
Range("A2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("E6:I6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("B2:B15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Windows("sttt.xls").Activate
Range("G4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("J2:J15").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("K1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("E2:E15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("sttt.xls").Activate
Range("J13:J26").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Workbooks.Open Filename:= _
"E:\SERVIM\Livrari dupa inventar\FISIER Save As BL.xls"
Windows("sttt.xls").Activate
Windows("FISIER Save As BL.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
Range("A2").Select
Selection.Copy
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Application.CutCopyMode = False
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("FISIER Save As BL.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
Range("B2").Select
Selection.Copy
Windows("sttt.xls").Activate
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ChDir "F:\Livrari dupa inventar\probe1.05.06"
sFilename = Format(Worksheets("Sheet1").Range("g4").Value, "@")
ans = MsgBox("Save file as " & sFilename)
If ans = vbOK Then
ActiveWorkbook.SaveAs Filename:=sFilename
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=2, Collate _
:=True
Windows("FISIER Save As BL.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
ActiveWorkbook.Close
Workbooks.Open Filename:="E:\SERVIM\livrari dupa inventar\sttt.xls"
Windows("sttt.xls").Activate
ActiveWindow.WindowState = xlMaximized
Range("G4").Select
ActiveCell.FormulaR1C1 = ""
Range("D13:J26").Select
Selection.ClearContents
Range("M13:M26").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-8
Range("E6:I6").Select
ActiveCell.FormulaR1C1 = ""
Range("E6:I6").Select
Range("L1").Select
Selection.Copy
Range("K1").Select
ActiveSheet.Paste
ActiveWorkbook.Save
End If
End Sub
Thanks for any help
Emil
Register To Reply
Bookmarks