Answer to Question 1: Â YES, I'm looking for a way to direct the save to a specific user chosen location (the Save As was a nice extra I hadn't thought of.... I'm going to also need to retrieve the file and import it later....so it might be good to simply save it with one particular name that the User cannot change).
Sub RoundedRectangle8_Click()
On Error GoTo Err
Dim src As String
src = Application.GetOpenFilename("Excel,*.xls", , "Select file")
If src = "False" Then Exit Sub
Dim wb1 As Workbook, wb2 As Workbook
Dim ws2 As Worksheet
Dim w As Worksheet
Dim targetSN As String
targetSN = "Industry_DB"
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open(src)
Set ws2 = wb2.Worksheets("Industry_DB")
ActiveWindow.Visible = False
Application.DisplayAlerts = False
For Each w In wb1.Worksheets
If w.Name = targetSN Then
w.Delete
Exit For
End If
Next
Application.DisplayAlerts = True
wb1.Worksheets.add After:=wb1.Worksheets(wb1.Worksheets.Count)
ws2.Cells.Copy wb1.Sheets(wb1.Worksheets.Count).Cells
wb1.Worksheets(wb1.Worksheets.Count).Name = targetSN
wb1.Worksheets(1).Select
'Windows(wb2.Name).Visible = True
Application.DisplayAlerts = False
wb2.Close SaveChanges:=False
Application.DisplayAlerts = True
wb1.Save
Set wb1 = Nothing
Set wb2 = Nothing
Exit Sub
Err:
MsgBox "Error while importing worksheet", vbCritical, "Error"
End Sub
[b]Pls make your backups before run the scripts, and you can customize the logic accordingly.[/b]
Sub RoundedRectangle1_Click()
Dim Path As String
Dim fileName As String
Path = BrowseForFolder()
If Path = "" Then Exit Sub
'Path = IIf(Right(Cells(8, 3), 1) <> "\", Cells(8, 3) & "\", Cells(8, 3))
Path = IIf(Right(Path, 1) <> "\", Path & "\", Path)
'try customize this accordingly
fileName = "Industry_DB" & Format(Now(), "YYYYMMDD HHMMSS") & ".xls"
ThisWorkbook.Worksheets("Industry_DB").Visible = True
Worksheets("Industry_DB").Copy
ActiveWorkbook.SaveAs Path & fileName, xlExcel8
ThisWorkbook.Worksheets("Industry_DB").Visible = False
MsgBox Path & fileName & " saved successfully.", vbInformation, "Completed"
End Sub
Sub ExportUseCaseDB_Click()
Dim Path As String
Dim fileName As String
Dim b As Boolean
Dim srcWS As String
srcWS = "UseCase_DB"
Path = BrowseForFolder()
If Path = "" Then Exit Sub
'Path = IIf(Right(Cells(8, 3), 1) <> "\", Cells(8, 3) & "\", Cells(8, 3))
Path = IIf(Right(Path, 1) <> "\", Path & "\", Path)
'try customize this accordingly
fileName = srcWS & Format(Now(), "YYYYMMDD HHMMSS") & ".xlsm"
b = ThisWorkbook.Worksheets(srcWS).Visible
ThisWorkbook.Worksheets(srcWS).Visible = True
Worksheets(srcWS).Copy
ActiveWorkbook.SaveAs Path & fileName, xlOpenXMLWorkbookMacroEnabled
ThisWorkbook.Worksheets(srcWS).Visible = b
MsgBox Path & fileName & " saved successfully.", vbInformation, "Completed"
End Sub
Sub ImportUseCaseDB_Click()
On Error GoTo Err
Dim src As String
Dim targetSN As String
Dim wb1 As Workbook, wb2 As Workbook
Dim ws2 As Worksheet
Dim w As Worksheet
Dim idx As Integer
targetSN = "UseCase_DB"
src = Application.GetOpenFilename("Excel (Macro Enabled Workbook),*.xlsm", , "Select file")
'src = Application.GetOpenFilename("Excel,*.xls", , "Select file")
If src = "False" Then Exit Sub
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open(src)
Set ws2 = wb2.Worksheets(targetSN)
ActiveWindow.Visible = False
If MsgBox("Are you sure want to continue?", vbExclamation + vbYesNo, "Overwrite?") = vbNo Then GoTo Q
Application.DisplayAlerts = False
idx = 1
For Each w In wb1.Worksheets
If w.Name = targetSN Then
w.Delete
Exit For
End If
idx = idx + 1
Next
Application.DisplayAlerts = True
'wb1.Worksheets.add After:=wb1.Worksheets(wb1.Worksheets.Count)
'ws2.Cells.Copy wb1.Sheets(wb1.Worksheets.Count).Cells
wb1.Worksheets.add Before:=wb1.Worksheets(idx)
ws2.Cells.Copy wb1.Sheets(idx).Cells
wb1.Worksheets(idx).Name = targetSN
'Hide worksheet
wb1.Worksheets(targetSN).Select
ActiveWindow.SelectedSheets.Visible = False
wb1.Worksheets(1).Select
'Windows(wb2.Name).Visible = True
Application.DisplayAlerts = False
wb2.Close SaveChanges:=False
Application.DisplayAlerts = True
wb1.Save
Set wb1 = Nothing
Set wb2 = Nothing
Exit Sub
Err:
MsgBox "Error while importing worksheet", vbCritical, "Error"
'Exit Sub
Q:
On Error Resume Next
Set w = Nothing
Set ws2 = Nothing
'wb1.Close
wb2.Close False
'Set wb1 = Nothing
Set wb2 = Nothing
End Sub
2.) When I import it, it changes the Sheet number (in the Developers Tab) so other Macros are thrown off. Â I need the macro to simply replace the existing sheet with the one saved.
[ https://www.experts-exchange.com/questions/28706636/Exporting-a-WS-to-a-specified-Location.html ]
PS. The attached file, "D--Data-Data-Temp-Save-to
"D--Data-Data-Temp-Save-to
[ http://filedb.experts-exchange.com/incoming/2015/08_w34/930515/D--Data-Data-Temp-Save-to-Export-and-Imp ]