Array Question - Select one from array list

Lee Rabbit

New Member
Joined
Apr 30, 2020
Messages
41
Office Version
  1. 2010
Platform
  1. Windows
Hi Guys,

I have the code below that selects certain worksheets in an array and then saves a new .xlsx file into the users documents folder.

I'd like to expand on this code so that it only copies the active worksheet from the array list. Is this at all possible?

I can't seem to get my head around it.

All the sheets have the same command button that calls the same macro. So all I want to do is call the copy function based on the active sheet I am in.

Any help is always appreciated. Thanks
Lee

VBA Code:
Sub Save_Week()

Dim ws As Worksheet
Dim strFileName As String

    strFileName = InputBox("Please enter a name for the file you are about to create, for example, DSA INSYNC WEEK 1. Once created, the file will be saved in your documents folder on your computer", "YOU ARE ABOUT TO SAVE THIS WEEK'S DATA")
    If Trim(strFileName) = vbNullString Then Exit Sub
    
    ActiveWorkbook.Sheets(Array("DSA1 INVOICE", "DCF1 INVOICE", "DBS2 INVOICE", "DBH2 INVOICE", "DPO2 INVOICE", "DSO1 INVOICE", "DSO2 INVOICE")).Copy
    
    For Each ws In ActiveWorkbook.Worksheets
    
       
        ws.Unprotect
        ws.UsedRange.Value = ws.UsedRange.Value
        ws.Rows(3).Delete
        ws.Shapes("CopyRow").Delete
        ws.Shapes("SortDrivers").Delete
        ws.Shapes("DeleteENTRY").Delete
        ws.Shapes("SaveWEEK").Delete
        
    Next ws
    
      
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Fldr & strFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
    
End Sub
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,670
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub Save_Week()

Dim ws As Worksheet
Dim strFileName As String

    strFileName = InputBox("Please enter a name for the file you are about to create, for example, DSA INSYNC WEEK 1. Once created, the file will be saved in your documents folder on your computer", "YOU ARE ABOUT TO SAVE THIS WEEK'S DATA")
    If Trim(strFileName) = vbNullString Then Exit Sub
    
    ActiveSheet.Copy
    
    With ActiveSheet
    
       
        .Unprotect
        .UsedRange.Value = .UsedRange.Value
        .Rows(3).Delete
        .Shapes("CopyRow").Delete
        .Shapes("SortDrivers").Delete
        .Shapes("DeleteENTRY").Delete
        .Shapes("SaveWEEK").Delete
        
    End With
    
      
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Fldr & strFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
    
End Sub
 
Solution

Lee Rabbit

New Member
Joined
Apr 30, 2020
Messages
41
Office Version
  1. 2010
Platform
  1. Windows
How about
VBA Code:
Sub Save_Week()

Dim ws As Worksheet
Dim strFileName As String

    strFileName = InputBox("Please enter a name for the file you are about to create, for example, DSA INSYNC WEEK 1. Once created, the file will be saved in your documents folder on your computer", "YOU ARE ABOUT TO SAVE THIS WEEK'S DATA")
    If Trim(strFileName) = vbNullString Then Exit Sub
   
    ActiveSheet.Copy
   
    With ActiveSheet
   
      
        .Unprotect
        .UsedRange.Value = .UsedRange.Value
        .Rows(3).Delete
        .Shapes("CopyRow").Delete
        .Shapes("SortDrivers").Delete
        .Shapes("DeleteENTRY").Delete
        .Shapes("SaveWEEK").Delete
       
    End With
   
     
   
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Fldr & strFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
   
End Sub
You know those times when you just clearly overthink things, well today was one of those times! #obviousreally #tired #LOL

Thanks Fluff, appreciate it
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,670
Office Version
  1. 365
Platform
  1. Windows
Glad to help & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,832
Messages
5,627,150
Members
416,223
Latest member
RichardHell

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top