Hudson
11-21-2016, 12:56 PM
Hi all,
I have this below code that create a duplicate copy with values only and saves in the path mentioned .
now i cant always go to VB editor and put a new path there . hence i want that to put some where in sheet1("A2") range . and i can change it as per my need.
below is the code that i got .
Sub SaveAs_NewWb_02()'Nov 19, 2016
Dim mywb As Workbook, wb As Workbook
Set mywb = ThisWorkbook
Dim ws As Worksheet
Dim v As Variant, vv As Variant
v = Array("summary", "invoices", "credits") '<< sht names
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Workbooks.Add
For Each vv In v
Set ws = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
ws.Name = vv
mywb.Sheets(vv).UsedRange.Copy
ws.Cells(1, 1).PasteSpecial xlPasteValuesAndNumberFormats
ws.Cells(1, 1).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
ws.UsedRange.EntireColumn.AutoFit
Application.CutCopyMode = False
Next
For Each sh In wb.Worksheets
If sh.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious) Is Nothing Then
sh.Delete
End If
Next
With wb
'change path as needed
.SaveAs "c:\Users\Hudson" & Sheets("invoices").Range("B2").Value, 51 'formats: 51=xlsx 52=xlsm, 56=xls
.Close False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
any inputs are appreciated.
Thanks .
I have this below code that create a duplicate copy with values only and saves in the path mentioned .
now i cant always go to VB editor and put a new path there . hence i want that to put some where in sheet1("A2") range . and i can change it as per my need.
below is the code that i got .
Sub SaveAs_NewWb_02()'Nov 19, 2016
Dim mywb As Workbook, wb As Workbook
Set mywb = ThisWorkbook
Dim ws As Worksheet
Dim v As Variant, vv As Variant
v = Array("summary", "invoices", "credits") '<< sht names
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Workbooks.Add
For Each vv In v
Set ws = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
ws.Name = vv
mywb.Sheets(vv).UsedRange.Copy
ws.Cells(1, 1).PasteSpecial xlPasteValuesAndNumberFormats
ws.Cells(1, 1).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
ws.UsedRange.EntireColumn.AutoFit
Application.CutCopyMode = False
Next
For Each sh In wb.Worksheets
If sh.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious) Is Nothing Then
sh.Delete
End If
Next
With wb
'change path as needed
.SaveAs "c:\Users\Hudson" & Sheets("invoices").Range("B2").Value, 51 'formats: 51=xlsx 52=xlsm, 56=xls
.Close False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
any inputs are appreciated.
Thanks .