Reputation: 27
I created MACRO in my order calculation template to deleted some unnecessary rows and save a sheet as workbook with "name". MACRO works great, but where is one annoying problem, I every time have change it this workbook name according to order number. So, I want to create/improve my MACRO to save sheet as workbook with cell name (this cell range "G1").
Could someone have ideas how to do this?
Sub Pirmoji()
'
' Pirmoji Macro
Sheets("Svorio Patvirtinimo dok").Select
ActiveSheet.Shapes.Range(Array("Column1")).Select
Sheets("Svorio Patvirtinimo dok").Copy
Rows("1:6").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=66
Dim LastRow As Long, myCell As Range, myRange As Range
Dim myCell1 As Range
LastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
Set myCell1 = Range("A" & LastRow)
Cells.Find(What:="• Praau atkreipti d?mes?:", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Set myCell = ActiveCell
Set myRange = Range(myCell, myCell1)
myRange.EntireRow.Delete
ActiveWindow.SmallScroll Down:=-78
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Copy
MsgBox "This new workbook will be saved as MyWb.xls(x)"
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\MyWb", xlWorkbookNormal
MsgBox "It is saved as " & ActiveWorkbook.FullName & vbLf & "Press OK to close it"
ActiveWorkbook.Close False
End Sub
Upvotes: 0
Views: 4967
Reputation: 33672
The code below will fix only the relevant part of your post, how to save "Svorio Patvirtinimo dok"
sheet as a new workbook, and file name according to the value in "G1".
You can do a lot of improvements also in the upper section of your code, there are a lot of unnecessary Select
, Selection
and ActiveCell
.
Read HERE why you should avoid using Select
, Activate
and other similar types.
Modified Code (relevant section only):
Dim Sht As Worksheet
Dim NewWBName As String
' set the worksheet object
Set Sht = ThisWorkbook.Sheets("Svorio Patvirtinimo dok")
MsgBox "This new workbook will be saved as MyWb.xls(x)"
' set the bnew name in same path and file name according to the value in "G1"
NewWBName = ThisWorkbook.Path & "\" & Sht.Range("G1").Value2 & ".xlsx"
'save sheet as workbook with the name in cell "G1"
Sht.SaveAs NewWBName, 51 ' save format 51 - .xlsx
MsgBox "It is saved as " & NewWBName & vbLf & "Press OK to close it"
ActiveWorkbook.Close False
Upvotes: 2