Switch sheets before saving

[Steve DeWeese]

I have a script (thanks to the help of others) that breaks up a master workbook into separate files for individual locations. The script copies data from 3 different tabs in a workbook to 3 different tabs in a new workbook. The script ends on the 3rd tab before saving and that is the tab that the new file opens to when opened for the first time. I would like to have it switch to the first tab before saving so that is the tab the file opens to by default. The sheet I would like it to open to is named Delivery Report. I tried adding two lines:
Sheets("Delivery Report").Select
Range("A1").Select
this did not resolve the issue.

Below is the full VBA Script. I disabled the email portion because I could not get it to work.

Sub breakMyList()
    ' This macro takes values in the range myList
    ' and breaks it in to multiple lists
    ' and saves them to separate files.
  
    Dim cell As Range
    Dim curPath As String
    Dim wbTar As Workbook
    Dim wbScr As Workbook
    Dim dSht, tSht As Worksheet
    Dim sRows, sCol, rr, cc As Long
    Dim dStart, tStart, scrData, critRange As Range
    Dim sd, st, cd, cs, rd, rt As String
    curPath = ActiveWorkbook.Path & "\"
  
    Set wbScr = ThisWorkbook
  
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
  
    For Each cell In Range("lstClinic")
        wbScr.Activate
            On Error Resume Next
            ActiveSheet.ShowAllData
            Err.Clear

        Workbooks.Add
        Set wbTar = ActiveWorkbook
        wbTar.Worksheets.Add.Name = "Surgery Days"
        wbTar.Worksheets.Add.Name = "Surgery Details"
        wbTar.Worksheets.Add.Name = "Delivery Report"

        wbScr.Activate

        [valClinic] = cell.Value

       Set dSht = Sheets("Delivery Report")
       Set cStart = dSht.Range("Criteria_DelRep")
       Set dStart = dSht.Range("myList")
      
       dStart.Select
       sRows = Selection.CurrentRegion.Rows.Count
       sCol = Selection.CurrentRegion.Columns.Count
       rr = dStart.Row
       cc = dStart.Column
       Set srcData = Range(Cells(rr, cc), Cells(rr + sRows, cc + sCol))
  
        cStart.Select
        sRows = Selection.CurrentRegion.Rows.Count
        sCol = Selection.CurrentRegion.Columns.Count
        rr = cStart.Row
        cc = cStart.Column
        Set critRange = Sheets("Delivery Report").Range(Cells(rr, cc), Cells(rr + sRows - 1, cc + sCol))

        srcData.AdvancedFilter Action:=xlFilterInPlace, criteriarange:= _
        critRange, Unique:=False
  
        dStart.CurrentRegion.Select
        Selection.Copy
        wbTar.Sheets("Delivery Report").Paste
      
      
    'Surgery Details
       Set dSht = Sheets("Surgery Details")
       Set dStart = dSht.Range("A1")
       dSht.Activate
            On Error Resume Next
            ActiveSheet.ShowAllData
            Err.Clear

       dStart.Select
       sRows = Selection.CurrentRegion.Rows.Count
       sCol = Selection.CurrentRegion.Columns.Count
       rr = dStart.Row
       cc = dStart.Column
       Set srcData = Range(Cells(rr, cc), Cells(rr + sRows, cc + sCol))
  

        srcData.AdvancedFilter Action:=xlFilterInPlace, criteriarange:= _
        critRange, Unique:=False
  
        dStart.CurrentRegion.Select
        Selection.Copy
        wbTar.Sheets("Surgery Details").Paste

       'Surgery Days
       Set dSht = Sheets("Surgery Days")
       Set dStart = dSht.Range("A1")
       Set dDel = Sheets("Delivery Report")
       dSht.Activate
            On Error Resume Next
            ActiveSheet.ShowAllData
            Err.Clear
      
       dStart.Select
       sRows = Selection.CurrentRegion.Rows.Count
       sCol = Selection.CurrentRegion.Columns.Count
       rr = dStart.Row
       cc = dStart.Column
       Set srcData = Range(Cells(rr, cc), Cells(rr + sRows, cc + sCol))

        srcData.AdvancedFilter Action:=xlFilterInPlace, criteriarange:= _
        critRange, Unique:=False
  
        dStart.CurrentRegion.Select
        Selection.Copy
        wbTar.Sheets("Surgery Days").Paste
        'dDel.Activate
        Sheets("Delivery Report").Select
        Range("A1").Select
       wbTar.SaveAs Filename:=curPath & cell.Value & Format(Now, "dmmmyyyy-hhmmss") & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
      
'Sub Mail_workbook_Outlook_1()
        'Working in Excel 2000-2013
        'This example send the last saved version of the Activeworkbook
        'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
        'Dim OutApp As Object
        'Dim OutMail As Object

            'Set OutApp = CreateObject("Outlook.Application")
            'Set OutMail = OutApp.CreateItem(0)

            'On Error Resume Next
        'With OutMail
            '.to = "sdeweese@clearchoice.com"
            '.cc = ""
            '.BCC = ""
            '.Subject = "Delivery Report"
            '.Body = "Please validate the attached delivery report"
            '.Attachments.Add wbTar.FullName
                'You can add other files also like this
                '.Attachments.Add ("C:\test.txt")
            '.Send   'or use .Display
            'End With
            'On Error GoTo 0

            'Set OutMail = Nothing
            'Set OutApp = Nothing

        wbTar.Close
        wbScr.Activate
    Next cell
  
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
  
End Sub

 

[Hui]

Steve

Where is the code located?
I suspect it is in a worksheet module

Try shifting it to a code module and re-run
or
change the line
from: Range("A1").Select
to: Sheets("Delivery Report").Range("A1").Select

 

[Steve DeWeese]

I will try your suggestion to combine the sheet and range statements when I am in the office tomorrow. I'm not familiar with the difference between a sheet module and a code module. This is in module 1 on the developer tab, if that helps at all. Thank you for your help.

 

[Steve DeWeese]

I made the suggested change but when I open one of the new files created by the code, it still opens to the tab "Surgery Days". The Module shows (code) next to it, so I believe it is the code module referenced. I would appreciate any other suggestions to get this to where the new files open to the first tab instead of the 3rd.

Thank you!

 

[NARAYANK991]

Hi Steve ,

Change this portion :

        dStart.CurrentRegion.Select
        Selection.Copy
        wbTar.Sheets("Surgery Days").Paste
       'dDel.Activate
       Sheets("Delivery Report").Select
        Range("A1").Select
       wbTar.SaveAs Filename:=curPath & cell.Value & Format(Now, "dmmmyyyy-hhmmss") & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

to this :

        dStart.CurrentRegion.Select
        Selection.Copy
        wbTar.Sheets("Surgery Days").Paste
        Application.CutCopyMode = False

        wbTar.Sheets("Delivery Report").Activate
        ActiveSheet.Range("A1").Select
        wbTar.SaveAs Filename:=curPath & cell.Value & Format(Now, "dmmmyyyy-hhmmss") & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Narayan

 

[Steve DeWeese]

Fantastic, that did it! So I can better understand, is it possible for you to explain the difference between what was there and what your solution does differently? I always try and learn along the way.

 

[NARAYANK991]

Hi Steve ,

The basic problem was this statement :

Sheets("Delivery Report").Select

A sheet is always selected from the activeworkbook ; if it is to be selected from any other workbook , it needs to be qualified by prefixing the above statement with the workbook name.

Normally , if a sheet name is not present in the activeworkbook , and the above statement is issued , Excel would have displayed an error message , but the statement :

On Error Resume Next

disables this !

Generally it is a bad idea to use the above statement , unless you know exactly what kind of errors can come up , and you can ensure that such errors do not matter to your code. An example would be a statement which uses the MATCH function , which , in case a match is not found will generate an error. In such cases , it is easy to disable Excel's error trapping , and handle such an error within the code.

Generally , it is also a good idea to have the above On Error statement just before the code which can generate an error , and follow it up as soon as possible with a statement such as :

On Error GoTo 0

so that normal error trapping is in place.

Narayan

 

[Steve DeWeese]

Thank you, I learn a little with each problem I encounter.