neodjandre
Well-known Member
- Joined
- Nov 29, 2006
- Messages
- 950
- Office Version
- 2019
- Platform
- Windows
Hey all,
I developed this function which works great. The only caveat is that I would like the hidden rows in the original workbook to be deleted in the new workbook. Any ideas would be much appreciated.
I developed this function which works great. The only caveat is that I would like the hidden rows in the original workbook to be deleted in the new workbook. Any ideas would be much appreciated.
VBA Code:
Sub export_values()
Dim sourceWB As Workbook
Dim destWB As Workbook
Dim ws As Worksheet
Dim path As String
Dim fname As String
Dim sh As Worksheet
Dim i As Integer
Dim shp As Shape
If MsgBox("This procedure will export the values of all sheets to a new workbook." & vbCr & vbCr & _
"Are you sure you wish to proceed?", vbYesNo + vbInformation, "") = vbNo Then Exit Sub
path = ThisWorkbook.path & "\"
fname = "values_" & Format(Now, "dd_mmm_yy_hh_mm_ss") & ".xlsb"
Set sourceWB = ThisWorkbook
Set destWB = Workbooks.Add
destWB.SaveAs path & fname, FileFormat:=xlExcel12
For Each ws In sourceWB.Worksheets
If CLng(ws.Range("B1").value) = "2" Then
i = i + 1
ws.Copy After:=destWB.Sheets(destWB.Sheets.Count)
End If
Application.StatusBar = "Processing..." & ws.Name
Next ws
For Each sh In destWB.Worksheets
With sh.UsedRange
.value = .value
End With
For Each shp In sh.Shapes
shp.Delete
Next shp
Application.StatusBar = "Converting..." & sh.Name
Next sh
destWB.Save
ThisWorkbook.Activate
MsgBox i & " sheets have been successfully exported to a new workbook.", vbInformation, ""
End Sub