Copy each sheet to new workbook, paste values and save to specific folder

[vbanovice1]

Hi all
I've been looking for threads that could help but haven't found any that I've been able to use.

My problem is that I have a workbook with multiple sheets, each sheet has formulas to get info from 2 other sheets in the workbook.
I need to copy each sheet (except for the two with the info) separately to another workbook, paste values and formatting, lock all cells except for a small range and then save each workbook to a specific place with the values in cells B2 and B4 as the name of the new workbook.
I have this code but I always get #Value in the cells that have formulas in them, not the values. Can anyone help me with this problem?


Sub CopyWorksheets()

Dim ws As Worksheet
MyPath = "the path to the folder I've chosen"


For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Reiknireglur" Or "Ýmislegt" Then
Else
ws.Copy
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Protect Password:="Password"
ActiveWorkbook.SaveAs FileName:=MyPath & "\" & Range("B2") & " " & Range("B4") & " - " & "vor 2024" & ".xlsx"
ActiveWorkbook.Close savechanges:=False
End If
Next ws

End Sub

 

[JerrExcel]

Hi there,

I have fixed some issue in your code.
1. IF Condition with OR, you need to define both situation like "IF ws.name = a OR ws.name = b Then"
2. I have try to use copy paste special PasteFormats & PasteValues, before locking with password.

But I am not sure about "lock all cells except for a small range": which range that you need it to be editable. For now, code below will lock the whole sheet.

Try the code:

Sub CopyWorksheets()

Dim ws As Worksheet
mypath = "the path to the folder I've chosen"


For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Reiknireglur" Or ws.Name = "Ýmislegt" Then
Else
ws.Copy
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues

ActiveSheet.Protect Password:="Password"
ActiveWorkbook.SaveAs Filename:=mypath & "\" & Range("B2") & " " & Range("B4") & " - " & "vor 2024" & ".xlsx"
ActiveWorkbook.Close savechanges:=False
End If
Next ws

End Sub

Hope this helped. Thanks!

 

[vbanovice1]

Hi there,

I have fixed some issue in your code.
1. IF Condition with OR, you need to define both situation like "IF ws.name = a OR ws.name = b Then"
2. I have try to use copy paste special PasteFormats & PasteValues, before locking with password.

But I am not sure about "lock all cells except for a small range": which range that you need it to be editable. For now, code below will lock the whole sheet.

Try the code:

Sub CopyWorksheets()

Dim ws As Worksheet
mypath = "the path to the folder I've chosen"


For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Reiknireglur" Or ws.Name = "Ýmislegt" Then
Else
ws.Copy
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues

ActiveSheet.Protect Password:="Password"
ActiveWorkbook.SaveAs Filename:=mypath & "\" & Range("B2") & " " & Range("B4") & " - " & "vor 2024" & ".xlsx"
ActiveWorkbook.Close savechanges:=False
End If
Next ws

End Sub

Hope this helped. Thanks!

Thank you for the help. I tried the code but I get an error when saving, the cells I'm referring to to get the name of the workbook when saving have #Value in them, so the paste values hasn't worked I assume, do you have any idea how to fix that?

 

[JerrExcel]

Hmmm,

I assume you are using formulas inside Range("B2") and Range("B4").
So whenever copying it to a new workbook, it all changing into #value.

Lets try to grab that values before we copy worksheet:
(Also, please make sure both your B2 and B4 do not contains special character that we cannot save as a filename)

Sub CopyWorksheets2()

Dim ws As Worksheet
Dim mypath As String
mypath = "the path to the folder I've chosen"


For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Reiknireglur" Or ws.Name = "Ýmislegt" Then
Else

Dim name1 As String
Dim name2 As String
name1 = ws.Range("B2").Value
name2 = ws.Range("B4").Value

ws.Copy
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats


ActiveSheet.Protect Password:="Password"
ActiveWorkbook.SaveAs Filename:=mypath & "\" & name1 & " " & name2 & " - " & "vor 2024" & ".xlsx"
ActiveWorkbook.Close savechanges:=False
End If
Next ws

End Sub

 

[vbanovice1]

Hmmm,

I assume you are using formulas inside Range("B2") and Range("B4").
So whenever copying it to a new workbook, it all changing into #value.

Lets try to grab that values before we copy worksheet:
(Also, please make sure both your B2 and B4 do not contains special character that we cannot save as a filename)

Sub CopyWorksheets2()

Dim ws As Worksheet
Dim mypath As String
mypath = "the path to the folder I've chosen"


For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Reiknireglur" Or ws.Name = "Ýmislegt" Then
Else

Dim name1 As String
Dim name2 As String
name1 = ws.Range("B2").Value
name2 = ws.Range("B4").Value

ws.Copy
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats


ActiveSheet.Protect Password:="Password"
ActiveWorkbook.SaveAs Filename:=mypath & "\" & name1 & " " & name2 & " - " & "vor 2024" & ".xlsx"
ActiveWorkbook.Close savechanges:=False
End If
Next ws

End Sub

Thanks again!
This works better now, but I think the problem is with the copy pasting, the sheets are all saved as workbooks but when I open the workbooks they have #Value in the fields where the formulas were

 

[JerrExcel]

Hi,

Can you show the formula in those cells? is the formula referencing to another sheet or another workbook? Would like to know more about the issue.

Thanks

 

[vbanovice1]

Hi,

Can you show the formula in those cells? is the formula referencing to another sheet or another workbook? Would like to know more about the issue.

Thanks

Hi,
In the top cell this is the formula - I use it to get the sheet name
=TRIM(MID(CELL("filename";A1);FIND("]";CELL("filename";A1);1)+1;255))

in the other cells I have an xlookup formula that references the first cell and then gets values from a table in another sheet in the workbook

 

[JerrExcel]

Hi,

Since you are using VBA macro, why not use VBA to return the sheet name in the cell B2?

It will be something like "ws.Range("B2").Value = ws.Name", so we do not need to use complicated excel formula there.

Try this updated code:

Sub CopyWorksheets2()

Dim ws As Worksheet
Dim mypath As String
mypath = "the path to the folder I've chosen"


For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Reiknireglur" Or ws.Name = "Ýmislegt" Then
Else

ws.Range("B2").Value = ws.Name

Dim name1 As String
Dim name2 As String
name1 = ws.Range("B2").Value
name2 = ws.Range("B4").Value

ws.Copy
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats


ActiveSheet.Protect Password:="Password"
ActiveWorkbook.SaveAs Filename:=mypath & "\" & name1 & " " & name2 & " - " & "vor 2024" & ".xlsx"
ActiveWorkbook.Close savechanges:=False
End If
Next ws

End Sub