MACRO HELP! Save out worksheet to a new workbook and value out everything except for specific cell ranges

F

fisht

New Member
Joined
Sep 1, 2013
Messages
47
Hi All,

I am in desperate need of a macro that can save out a particular worksheet from the current workbook to a new workbook. In addition to saving out this worksheet to its own new workbook, I would like the macro to also value out (remove formulas from) everything except for a specific cell range and columns with specific headers.

Details are below:

From old workbook..
Worksheet name: P&L

New workbook..
Worksheet name- same as above (P&L)
Cell range to NOT value out- E11:E13
10 Columns to NOT value out based on headers in row 24 of worksheet- Placed Revenue, Gross Revenue, Net Revenue, Return COGS, COGS, Returns, Total COGS, Gross Profit, MMU%, GM%.
*The reason I would like these column headers to be referenced is because the positioning of these headers change to different columns.

New worksheet's file path (generic)- C:\My Documents\Financials

Having such a macro would be a HUGE help and time savings for me and I would be so grateful. Please let me know if I can assist by answering any questions. I will be continually viewing this post and will be quick to respond.

Thank you!
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
Hi fisht,
Try something like this out and see if I got everything you mentioned. (It seems to be working fine for me in testing.)
Note that you never mentioned what you wanted to name the new workbook, so I have it being named "P_and_L Copy" followed by the current date being formatted as month-day-year. This will cause a file saving error if you want to do it more than once a day, so you may need to come up with a different name.
Code: 
Sub MakeCopyAndSaveAsValues()
Dim LstCol As Long, LstRw As Long
Dim MyPath As String, MyNewName As String
MyPath = "C:" & Application.PathSeparator & "My Documents" & Application.PathSeparator & "Financials" & Application.PathSeparator
MyNewName = "P_and_L Copy " & Format(Date, "m-d-yy")

LstCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Sheets("P&L").Copy
With ActiveWorkbook.Sheets("P&L")
  For Col = 1 To LstCol
    LstRw = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Select Case .Cells(24, Col).Value
      Case "Placed Revenue", "Gross Revenue", "Net Revenue", "Return COGS", _
           "COGS", "Returns", "Total COGS", "Gross Profit", "MMU%", "GM%"
        GoTo SkipThisColumn
    End Select
    If Col = 5 Then
      .Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
      .Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
    Else
      .Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
    End If
SkipThisColumn:
  Next Col
End With

ActiveWorkbook.SaveAs MyPath & MyNewName

End Sub

Hope it helps.
 
Upvote 0
Thank you for this HalfAce. My apologies for the delayed response, I will try your code out today and get back to you!

HalfAce said:
Hi fisht,
Try something like this out and see if I got everything you mentioned. (It seems to be working fine for me in testing.)
Note that you never mentioned what you wanted to name the new workbook, so I have it being named "P_and_L Copy" followed by the current date being formatted as month-day-year. This will cause a file saving error if you want to do it more than once a day, so you may need to come up with a different name.
Code: 
Sub MakeCopyAndSaveAsValues()
Dim LstCol As Long, LstRw As Long
Dim MyPath As String, MyNewName As String
MyPath = "C:" & Application.PathSeparator & "My Documents" & Application.PathSeparator & "Financials" & Application.PathSeparator
MyNewName = "P_and_L Copy " & Format(Date, "m-d-yy")

LstCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Sheets("P&L").Copy
With ActiveWorkbook.Sheets("P&L")
  For Col = 1 To LstCol
    LstRw = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Select Case .Cells(24, Col).Value
      Case "Placed Revenue", "Gross Revenue", "Net Revenue", "Return COGS", _
           "COGS", "Returns", "Total COGS", "Gross Profit", "MMU%", "GM%"
        GoTo SkipThisColumn
    End Select
    If Col = 5 Then
      .Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
      .Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
    Else
      .Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
    End If
SkipThisColumn:
  Next Col
End With

ActiveWorkbook.SaveAs MyPath & MyNewName

End Sub

Hope it helps.
Click to expand...
 
Upvote 0
Finally tested the macro you created and it did exactly what I requested. Thank you for this! However, could I trouble you to please add these two items to the existing code:

1) Not to value out cell 'H6' (the same way you did the cell range E11:E13) -- when saving out the new "P_and_L Copy" worksheet

2) Also when saving out the new "P_and_L Copy" worksheet, to carry over three tabs from the old workbook into the new workbook. I do not need these three tabs to be valued out. The three tabs are labeled: "Data", "MTD", and "YTD"

Please let me know if these additions are okay and thanks again.


HalfAce said:
Yeah, what's up with that???

( :laugh: )
Click to expand...
 
Upvote 0
You're most welcome, and it's no trouble at all.
Try replacing these parts of the code with these updates.
Replace this:
Code: 
Sheets("P&L").Copy
with this:
Code: 
Sheets(Array("P&L", "Data", "MTD", "YTD")).Copy

and then replace this:
Code: 
    If Col = 5 Then
      .Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
      .Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
    Else
      .Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
    End If
with this:
Code: 
    If Col = 5 Then
      .Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
      .Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
    ElseIf Col = 8 Then
      .Range(Cells(1, Col), Cells(5, Col)).Value = Range(Cells(1, Col), Cells(5, Col)).Value
      .Range(Cells(7, Col), Cells(LstRw, Col)).Value = Range(Cells(7, Col), Cells(LstRw, Col)).Value
    Else
      .Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
    End If

Hope it helps.
 
Upvote 0
It works so smoothly, thank you so much HalfAce! There's another cell that I would like to remove the valuing-out from, but I'm going to take a stab at it based on the new code you just provided.
 
Upvote 0
You're quite welcome.
Glad to see you want to take a stab at it yourself. Let us know how it works out for you.
 
Upvote 0
Hi HalfAce,

I did (somewhat successfully) add to your code and I have included the 'final code' below. Here are the two additions I made to the original code:

1) Adjusted the naming convention of the new file when it's being saved out:
"Set sh = ActiveWorkbook.Sheets("P&L")" & "MyNewName = sh.Range("E6") & "_" & Format(Date, "yyyy mm dd")"

2) Added another cell range that I did not want to be 'valued' out:
"ElseIf Col = 3 Then .Range(Cells(1, Col), Cells(12, Col)).Value = Range(Cells(1, Col), Cells(12, Col)).Value
.Range(Cells(17, Col), Cells(LstRw, Col)).Value = Range(Cells(17, Col), Cells(LstRw, Col)).Value"

However, there are two new items I need your help with adjusting the code in order to finalize the code:

1) When I run the below code, the correct cell ranges/columns indicated in the code are not valued however the code stops 'valuing' out everything else in the new "P&L" worksheet starting in column 'Q' and onwards.

2) The second adjustment I am looking to have included in the code would be to not value out cells starting with column 'BM' and onwards.

To clarify the above requests, the new code should value out everything (excluding the cell ranges/columns with specific column headers indicated in the current code) in between columns 'A' through 'BL'. Everything in columns 'BM' and onwards should not be valued out.

Please let me know if you have any questions or need me to provide you with more information, and thank you HalfAce!!

Final Code:

Sub MakeCopyAndSaveAsValues()
Dim LstCol As Long, LstRw As Long
Dim MyPath As String, MyNewName As String
Set sh = ActiveWorkbook.Sheets("P&L")
MyPath = "C:" & Application.PathSeparator & "My Documents" & Application.PathSeparator & "Financials" & Application.PathSeparator
MyNewName = sh.Range("E6") & "_" & Format(Date, "yyyy mm dd")


LstCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Sheets(Array("P&L", "Data", "MTD", "YTD")).Copy
With ActiveWorkbook.Sheets("P&L")
For Col = 1 To LstCol
LstRw = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Select Case .Cells(24, Col).Value
Case "Placed Revenue", "Gross Revenue", "Net Revenue", "Return COGS", _
"COGS", "Returns", "Total COGS", "Gross Profit", "MMU%", "GM%"
GoTo SkipThisColumn
End Select
If Col = 5 Then
.Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
.Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
ElseIf Col = 8 Then
.Range(Cells(1, Col), Cells(5, Col)).Value = Range(Cells(1, Col), Cells(5, Col)).Value
.Range(Cells(7, Col), Cells(LstRw, Col)).Value = Range(Cells(7, Col), Cells(LstRw, Col)).Value
ElseIf Col = 3 Then
.Range(Cells(1, Col), Cells(12, Col)).Value = Range(Cells(1, Col), Cells(12, Col)).Value
.Range(Cells(17, Col), Cells(LstRw, Col)).Value = Range(Cells(17, Col), Cells(LstRw, Col)).Value

Else
.Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
End If
SkipThisColumn:
Next Col
End With


ActiveWorkbook.SaveAs MyPath & MyNewName


End Sub
 
Upvote 0
After some more probing/testing, I thought it might be helpful to share some more information:

If I activate the below code within the 'P&L' worksheet (Alt + F8), the code does exactly as its supposed to. However, I have inserted a button on the first worksheet in the workbook and assigned the below macro to it, and when I click the button to run the macro the outcome is what I have listed in my prior post... I thought it was interesting that the result is different. I am looking to have the macro run via a button on the first worksheet of the workbook.

HalfAce, if you could examine and solve for this at your earliest convenience that would help me out a lot. I appreciate all your effort in solving for these scenarios I have presented to you.

Thank you!


fisht said:
Hi HalfAce,

I did (somewhat successfully) add to your code and I have included the 'final code' below. Here are the two additions I made to the original code:

1) Adjusted the naming convention of the new file when it's being saved out:
"Set sh = ActiveWorkbook.Sheets("P&L")" & "MyNewName = sh.Range("E6") & "_" & Format(Date, "yyyy mm dd")"

2) Added another cell range that I did not want to be 'valued' out:
"ElseIf Col = 3 Then .Range(Cells(1, Col), Cells(12, Col)).Value = Range(Cells(1, Col), Cells(12, Col)).Value
.Range(Cells(17, Col), Cells(LstRw, Col)).Value = Range(Cells(17, Col), Cells(LstRw, Col)).Value"

However, there are two new items I need your help with adjusting the code in order to finalize the code:

1) When I run the below code, the correct cell ranges/columns indicated in the code are not valued however the code stops 'valuing' out everything else in the new "P&L" worksheet starting in column 'Q' and onwards.

2) The second adjustment I am looking to have included in the code would be to not value out cells starting with column 'BM' and onwards.

To clarify the above requests, the new code should value out everything (excluding the cell ranges/columns with specific column headers indicated in the current code) in between columns 'A' through 'BL'. Everything in columns 'BM' and onwards should not be valued out.

Please let me know if you have any questions or need me to provide you with more information, and thank you HalfAce!!

Final Code:

Sub MakeCopyAndSaveAsValues()
Dim LstCol As Long, LstRw As Long
Dim MyPath As String, MyNewName As String
Set sh = ActiveWorkbook.Sheets("P&L")
MyPath = "C:" & Application.PathSeparator & "My Documents" & Application.PathSeparator & "Financials" & Application.PathSeparator
MyNewName = sh.Range("E6") & "_" & Format(Date, "yyyy mm dd")


LstCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Sheets(Array("P&L", "Data", "MTD", "YTD")).Copy
With ActiveWorkbook.Sheets("P&L")
For Col = 1 To LstCol
LstRw = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Select Case .Cells(24, Col).Value
Case "Placed Revenue", "Gross Revenue", "Net Revenue", "Return COGS", _
"COGS", "Returns", "Total COGS", "Gross Profit", "MMU%", "GM%"
GoTo SkipThisColumn
End Select
If Col = 5 Then
.Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
.Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
ElseIf Col = 8 Then
.Range(Cells(1, Col), Cells(5, Col)).Value = Range(Cells(1, Col), Cells(5, Col)).Value
.Range(Cells(7, Col), Cells(LstRw, Col)).Value = Range(Cells(7, Col), Cells(LstRw, Col)).Value
ElseIf Col = 3 Then
.Range(Cells(1, Col), Cells(12, Col)).Value = Range(Cells(1, Col), Cells(12, Col)).Value
.Range(Cells(17, Col), Cells(LstRw, Col)).Value = Range(Cells(17, Col), Cells(LstRw, Col)).Value

Else
.Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
End If
SkipThisColumn:
Next Col
End With


ActiveWorkbook.SaveAs MyPath & MyNewName


End Sub
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Copy Entire Workbook, save as sheet name with current date, hide all sheets except one, & attach to email
Replies
2
Views
470
Amo840812
A
P
  • Solved
writing a macro to copy an entire xlsm workbook to a users desktop as xlsx values only.
Replies
9
Views
642
Alex Blakenburg
A
R
  • Solved
Excel VBA to filter by unique value, copy paste into new workbook and save
Replies
2
Views
753
rittersportyummy
R
T
  • Question Question
Automatically Copying Data To A New Workbook When Closing A Workbook
Replies
4
Views
395
Tmini
T
B
  • Question Question
Copy and paste from one worksheet into a new workbook and save to a particular directory
Replies
3
Views
501
Joe4
Joe4

Forum statistics

Threads
1,223,236
Messages
6,170,906
Members
452,366
Latest member
TePunaBloke

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