Save Sheet as New Workbook using name of Sheet, to specified location

E

ejronin

New Member
Joined
Oct 18, 2015
Messages
12
Hi,

I'm "alright" with VBA at this point for someone only really working in it for a couple of months. I'm stuck on something that seems harder than it may be and was wondering what I'm doing wrong.

I'm looking to take a workbook (DATS), transpose data from specific cells to a new sheet and name the new sheet the value of a cell. From there, save that new sheet as a separate workbook to a new file in a different folder (on a different drive), check to see if that file exists - if it does, ask to overwrite and if that is okay, overwrite. if not, stop. For both delete the new sheet and notify the user the data has or has not been saved depending.

My existing patchwork code is below.

Code: 
Sub Cloud()
'=============================================================================================================
'This macro asks the suer if they are connected to the VPN. If they are, the sheet will transfer data to a new
'sheet and name it based on the data in cell AM3. AM3 is concatenated L2,AJ2, AJ3, and E5. This lets each sheet
'uploaded have a name unique to the auditor, but still classified by division, month, and week of month.
'
'If the user attempts to create a dataset a week in advance, they are denied.
'If the user attempts to create a second set of data in the same week without using a fresh sheet, they are denied
'
'If the user is not connected to the VPN, macro ends without doing anything and the user is asked to connect
'before attempting again.
'=============================================================================================================
 Dim ws As Worksheet, chkShtName As String
 
'VPN connection question
MSG1 = MsgBox("Are you currently connected to the VPN?", vbYesNo + vbQuestion, "VPN CONNECTION CHECK")


'Set variable to value in DATS!AM3
chkShtName = Sheets("DATS").Range("AM3")


If MSG1 = vbYes Then


  MsgBox "Please remain connected until this task is complete."
  
'If chkShtName is empty, notify and exit
'chkShtName should never be empty it pulls from concatenated data in cell AM3, but data can be incomplete and handled later.
  
  If chkShtName = "" Then
     MsgBox "CRITICAL ERROR: AM3 DATA MISSING" & vbNewLine & vbNewLine & _
     "Please use the 'Help Ticket' function in the upper right of the DATS form and inform of an 'AM3 Data Missing' error."
     Exit Sub
  End If
  
'If chkShtName (data in AM3) is not empty, check to see if Sheet exists.
'chShtName is concatenated information from 4 cells.
'The Set instruction will produce an error if the sheet does not exist.
'If sheet doesn't exist, it is "nothing"
   
   On Error Resume Next
     Set ws = Sheets(chkShtName)
   On Error GoTo 0
      
'If ws is Not Nothing then it exists and tell the user, exit sub
      
     If Not ws Is Nothing Then


       MsgBox "You can't create the same week of data twice in the same Workbook."
 
       Exit Sub
     End If
     
'add sheet named from data in cell AM3


      ActiveSheet.Copy After:=Sheets(Sheets.Count)
       ActiveSheet.Name = chkShtName
       
'delete direct copy and reset the entire sheet to default
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Cells.Select
    
        With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveSheet.Shapes.Range(Array("Picture 4")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Picture 2")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Picture 3")).Select
    Selection.Delete
    
'clear copied formatting and reset the text, color, etc.
    With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Selection.ClearContents


'label headers
        ActiveCell.FormulaR1C1 = "Auditor"
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "Date"
        Range("C1").Select
        ActiveCell.FormulaR1C1 = "Store"
        Range("D1").Select
        ActiveCell.FormulaR1C1 = "Arrive"
        Range("E1").Select
        ActiveCell.FormulaR1C1 = "Start"
        Range("F1").Select
        ActiveCell.FormulaR1C1 = "Stop"
        Range("G1").Select
        ActiveCell.FormulaR1C1 = "Depart"
        Range("H1").Select
        ActiveCell.FormulaR1C1 = "Drive"
        Range("I1").Select
        ActiveCell.FormulaR1C1 = "Research"
        Range("J1").Select
        ActiveCell.FormulaR1C1 = "Audit"
        Range("K1").Select
        ActiveCell.FormulaR1C1 = "Close"
        Range("L1").Select
        ActiveCell.FormulaR1C1 = "Retail"
        Range("M1").Select
        ActiveCell.FormulaR1C1 = "Speed"


'format cells
        Range("B2:B7").Select
        Selection.NumberFormat = "m/d/yy;@"
        Range("D2:G7").Select
        Selection.NumberFormat = "[$-409]h:mm AM/PM;@"
        ActiveCell.FormulaR1C1 = "=DATS!R[3]C[4]"
        Range("A2").Select
        ActiveCell.FormulaR1C1 = "=IF(DATS!R5C5="""","""",DATS!R5C5)"
        Range("A2").Select
        Selection.AutoFill Destination:=Range("A2:A7"), Type:=xlFillDefault
        Range("A2:A7").Select
        Range("B2").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[32]C[2]"
        Range("B2").Select
        Selection.AutoFill Destination:=Range("B2:B7"), Type:=xlFillDefault
 
 'transpose data
        Range("C2").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[23]C[1]"
        Range("C3").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[22]C[3]"
        Range("C4").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[21]C[5]"
        Range("C5").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[20]C[7]"
        Range("C6").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[19]C[9]"
        Range("C7").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[18]C[11]"
        Range("D2").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[13]C"
        Range("D3").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[12]C[2]"
        Range("D4").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[11]C[4]"
        Range("D5").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[10]C[6]"
        Range("D6").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[9]C[8]"
        Range("D7").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[8]C[10]"
        Range("E2").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[26]C[-1]"
        Range("E3").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[25]C[1]"
        Range("E4").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[24]C[3]"
        Range("E5").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[23]C[3]"
        Range("E5").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[23]C[5]"
        Range("E6").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[22]C[7]"
        Range("E7").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[21]C[9]"
        Range("F2").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[26]C[-1]"
        Range("F3").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[25]C[1]"
        Range("F4").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[24]C[3]"
        Range("F5").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[23]C[5]"
        Range("F6").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[22]C[7]"
        Range("F7").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[21]C[9]"
        Range("G2").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[12]C[-2]"
        Range("G3").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[11]C"
        Range("G4").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[10]C[2]"
        Range("G5").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[9]C[4]"
        Range("G6").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[8]C[6]"
        Range("G7").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[7]C[8]"
        Range("H2").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[16]C[-4]+DATS!R[16]C[-3]"
        Range("H3").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[15]C[-2]+DATS!R[15]C[-1]"
        Range("H4").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[14]C+DATS!R[14]C[1]"
        Range("H5").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[13]C[2]+DATS!R[13]C[3]"
        Range("H6").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[12]C[4]+DATS!R[12]C[5]"
        Range("H7").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[11]C[6]+DATS!R[11]C[7]"
        Range("I2").Select
        ActiveCell.FormulaR1C1 = "=(RC[-4]-RC[-5])*24"
        Range("I2").Select
        Selection.AutoFill Destination:=Range("I2:I7"), Type:=xlFillDefault
        Range("I2:I7").Select
        Selection.AutoFill Destination:=Range("I2:K7"), Type:=xlFillDefault
        Range("I2:K7").Select
        Range("L2").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[24]C[-8]"
        Range("L3").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[23]C[-6]"
        Range("L4").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[22]C[-4]"
        Range("L5").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[20]C[-2]"
        Range("L6").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[20]C"
        Range("L5").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[21]C[-4]"
        Range("L5").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[21]C[-2]"
        Range("L6").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[20]C"
        Range("L7").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[19]C[2]"
        Range("M2").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[22]C[-8]"
        Range("M3").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[21]C[-6]"
        Range("M4").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[20]C[-4]"
        Range("M5").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[19]C[-2]"
        Range("M6").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[18]C"
        Range("M7").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[17]C[2]"


'format cell size to accomodate the data
        Cells.EntireRow.AutoFit
        Cells.EntireColumn.AutoFit
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        ActiveSheet.Copy


'make new workbook from new sheet
    With ActiveSheet.UsedRange
        .PasteSpecial xlValues
        .PasteSpecial xlFormats
    End With
    ChDir "C:\Users\xxxxx\Desktop"
    
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="C:\Users\xxxxx\Desktop\" & chkShtName, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Else


  MsgBox "Connecting to the VPN is critical to this task." & vbNewLine & _
  vbNewLine & "Please connect and try again or save this sheet and upload your data when you're able to connect." & vbNewLine & _
  vbNewLine & "If you're unable to connect for an extended period because of network issues or travel," & _
  " please notify your Division Manager and Senior Auditors."
End If




End Sub

This is a stepped process (i.e. I'll work on bits at a time. Took me two weeks to get this far...

Right now, I run to an error 1004 at:
Code: 
With ActiveSheet.UsedRange
        .PasteSpecial xlValues
        .PasteSpecial xlFormats

Advice would be greatly appreciated and thank you in advance.
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
One suggestion which could save you a lot of work and time when you start writing code.

Code: 
'Your Code
        Range("H6").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[12]C[4]+DATS!R[12]C[5]"
        
        'My Code
        Range("H6").FormulaR1C1 = "=DATS!R[12]C[4]+DATS!R[12]C[5]"
 
Last edited:
Upvote 0
My Aswer Is This said:
One suggestion which could save you a lot of work and time when you start writing code.

Code: 
'Your Code
        Range("H6").Select
        ActiveCell.FormulaR1C1 = "=DATS!R[12]C[4]+DATS!R[12]C[5]"
        
        'My Code
        Range("H6").FormulaR1C1 = "=DATS!R[12]C[4]+DATS!R[12]C[5]"
Click to expand...

So, truncate the entries to take both steps at the same time by not telling it to select each cell and just add the data directly. Makes sense.

Thank you.
 
Upvote 0
Concerning this question:
Code: 
With ActiveSheet.UsedRange
        .PasteSpecial xlValues
        .PasteSpecial xlFormats

I cannot see what you copied.
And I see no End With

It should look something like this:

Code: 
Range("A1").Copy

With ActiveSheet.UsedRange
        .PasteSpecial xlValues
        .PasteSpecial xlFormats
End With

This bit of code is going to paste what ever you copied over every thing on your sheet. Are you sure you want to do this
 
Last edited:
Upvote 0
If your only wanting to copy values from one sheet to another you can do it this way. Now this data will not be updated if you change the values in those cells. There will be no formula in the cell just the data.

Code: 
Range("A1") = Sheets("Dats").Range("B1")
 
Upvote 0
My Aswer Is This said:
If your only wanting to copy values from one sheet to another you can do it this way. Now this data will not be updated if you change the values in those cells. There will be no formula in the cell just the data.

Code: 
Range("A1") = Sheets("Dats").Range("B1")
Click to expand...

Which is exactly the idea, but since DATS is basically a user form I'm attempting to make a new workbook saved to a destination folder that is simply values copied from the sheet made by the macro. I prefer there be no formulas in it and just data, so long as the data is what is displayed in the new sheet exactly.

The Workbook is designed around the idea that the macro is only run when all data has been input as part of a user submission process - user fills out their time sheets (that's what DATS is), clicks a button that packages it in an email and sends it off to their manager (not me). Then they run another macro that takes the entry data rather than copying the entire form, condenses it to a new sheet in a flat format, and I'm attempting to get it to package that in a very small workbook to upload on a network drive - but the name of the workbook needs to be very specific in structure (division)(month)(week of month)(username) - DATS and the above macro handle that in terms of making a new sheet. I'm just stuck taking that sheet and making it a new workbook that will save to a destination, then go back and delete the new sheet.

The DATS is a single instance weekly use form. Every time the user opens the sheet it should be blank with the week ending date set as the upcoming Sunday. So, this means that every time it's opened, the "new sheet" doesn't exist and is treated as if it never had. The duplication checks I'll have to put in apply only to the files stored on the network - which will ask the user if they want to overwrite it or not. If not, it needs to just stop the whole upload process and notify the user to upload again next week (which will force a name change of the file because the name is dependent on the data in the cell with the weekending date, which is locked and cannot be changed by the user).

A later part of the project will have a "Master" sheet that will poll the network drive for files with only the first two characters of the file name based on selection of a list (is the user is the NE manager, he or she will only import files pre-pended with NE, and so on), and then import the data from all files named by L2 on the user form (DATS) files provided (month), (week), (user) do not already exist and match in the existing sheet of each month. If it does, it'll ask the user if it wants to up date (overwrite) or leave it alone (nothing). If it doesn't exist, it will add to an existing table and a pivot table will handle the summary data and organization of data. This is why the naming is important and I hope this rather pedantic explanation sheds some light on why such an advice request seems kind of counter-intuitive to conventional practice.
 
Upvote 0
My Aswer Is This said:
If your only wanting to copy values from one sheet to another you can do it this way. Now this data will not be updated if you change the values in those cells. There will be no formula in the cell just the data.

Code: 
Range("A1:O7").Copy'modified to fit actual range of data to be copied
    With ActiveSheet.UsedRange
    .PasteSpecial xlValues
    .PasteSpecial xlFormats
    End With
Click to expand...

That little snippet change worked perfectly - thank you very much. I'll now move on to the next step of it all.

Thanks, so much, again.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Loop/Repeat Macro
2
Replies
11
Views
371
kvsrinivasamurthy
K
L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
976
Joe4
Joe4
P
  • Question
Help with Vba Code
Replies
3
Views
160
Coyotex3
C
K
  • Solved
formating question
Replies
3
Views
74
Micron
M
J
  • Question
VBA Code to Add Rows is slowing down
Replies
5
Views
512
JayB0730
J

Forum statistics

Threads
1,215,019
Messages
6,122,707
Members
449,093
Latest member
Mnur

Share this page

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
Back
Top