VBA to export .xlsb to .xlsx, values only (no formulas!)

[GVR16]

Hi all,

I'm new to this forum, so please excuse me if I am missing out on anything with my post. I need your help with creating a VBA code that allows me to export 2 worksheets from a binary file into a normal .xlsx file - but exporting only values. I've already created a macro using some YT tutorial, but I can't figure out how to make it export values only. Any advice would be greatly appreciated!

Sub ExportWorkSheets()

Dim wbSource As Workbook, wbTarget As Workbook
Dim worksheetList As String
Dim workshetArr As Variant
Dim i As Long

On Error GoTo errHandle
worksheetList = "Orders:Sales YTD"
worksheetarr = Split(worksheetList, ":")

If UBound(worksheetarr) = -1 Then Exit Sub

Set wbSource = ThisWorkbook
Set wbTarget = Workbooks.Add

For i = LBound(worksheetarr) To UBound(worksheetarr)
wbSource.Worksheets(worksheetarr(i)).Copy wbTarget.Worksheets(wbTarget.Worksheets.Count)
Next i

MsgBox "Export complete.", vbInformation

CleanObject:
    Set wbSource = Nothing
    Set wbTarget = Nothing

Exit Sub

errHandle:
MsgBox "Error: " & Err.Description, vbExclamation

End Sub

 

[Logit]

Im not certain about the macro you are attempting to use. The following macro from my toolbox does work.

Option Explicit

Sub copyAll()

Dim Output As Workbook, Source As Workbook
Dim sh As Worksheet
Dim FileName As String
Dim firstCell

Application.ScreenUpdating = False
Set Source = ActiveWorkbook

Set Output = Workbooks.Add
Application.DisplayAlerts = False

Dim i As Integer

On Error Resume Next

ThisWorkbook.Save

For Each sh In Source.Worksheets

    Dim newSheet As Worksheet

    ' select all used cells in the source sheet:
    sh.Activate
    sh.UsedRange.Select
    Application.CutCopyMode = False
    Selection.Copy

    ' create new destination sheet:
    Set newSheet = Output.Worksheets.Add(after:=Output.Worksheets(Output.Worksheets.Count))
    newSheet.Name = sh.Name

    ' make sure the destination sheet is selected with the right cell:
    newSheet.Activate
    firstCell = sh.UsedRange.Cells(1, 1).Address
    newSheet.Range(firstCell).Select

    ' paste the values:
    Range(firstCell).PasteSpecial Paste:=xlPasteColumnWidths
    Range(firstCell).PasteSpecial Paste:=xlPasteFormats
    Range(firstCell).PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=True, Transpose:=False

Next

' delete the sheets that were originally there
While Output.Sheets.Count > Source.Worksheets.Count
  Output.Sheets(1).Delete
Wend
FileName = "Testing WB"
Output.SaveAs "C:\Users\logit\Desktop\" & FileName  '<--- edit path as needed

Workbooks("Testing WB.xlsx").Close  '<--- edit name of workbook

'FileName = "Testing WB"
'Output.SaveAs "C:\Users\My\Desktop\Other\" & FileName  '<--- edit path as needed

Workbooks("Testing WB.xlsx").Close  '<--- edit name of workbook

'.Close SaveChanges:=True
Application.ScreenUpdating = True

End Sub

 

[Kaper]

Try that way (I used you code with small additions):

Sub ExportWorkSheets()

Dim wbSource As Workbook, wbTarget As Workbook
Dim worksheetList As String
Dim worksheetArr As Variant 'correct this line
Dim i As Long

On Error GoTo errHandle
worksheetList = "Orders:Sales YTD"
worksheetArr = Split(worksheetList, ":")

If UBound(worksheetArr) = -1 Then Exit Sub

Set wbSource = ThisWorkbook
Set wbTarget = Workbooks.Add

For i = LBound(worksheetArr) To UBound(worksheetArr)
  wbSource.Worksheets(worksheetArr(i)).Copy wbTarget.Worksheets(i + 1)
  wbTarget.Worksheets(i + 1).UsedRange.Value = wbTarget.Worksheets(i + 1).UsedRange.Value
Next i
While wbTarget.Worksheets.Count > UBound(worksheetArr) + 1
  Application.DisplayAlerts = False
  wbTarget.Worksheets(wbTarget.Worksheets.Count).Delete
Wend
MsgBox "Export complete.", vbInformation

CleanObject:
    Set wbSource = Nothing
    Set wbTarget = Nothing

Exit Sub

errHandle:
MsgBox "Error: " & Err.Description, vbExclamation

End Sub

1) corrected Dim worksheetArr As Variant
2) added assigning values in used range as values (this is equivalent to copy and paste special as values only) in each of copied worksheets
3) while - wend loop is optional. it removes all empty worksheets you'd have in newly created file (current standard is just Sheet1, but one can chenge the number of worksheets in options).
4) just in case 3rd above is used, I changed place where new sheets are added (again in standard situation - 1 sheet in new workbook it will be exactly the samme as original solution)

 

[GVR16]

Try that way (I used you code with small additions):

Sub ExportWorkSheets()

Dim wbSource As Workbook, wbTarget As Workbook
Dim worksheetList As String
Dim worksheetArr As Variant 'correct this line
Dim i As Long

On Error GoTo errHandle
worksheetList = "Orders:Sales YTD"
worksheetArr = Split(worksheetList, ":")

If UBound(worksheetArr) = -1 Then Exit Sub

Set wbSource = ThisWorkbook
Set wbTarget = Workbooks.Add

For i = LBound(worksheetArr) To UBound(worksheetArr)
  wbSource.Worksheets(worksheetArr(i)).Copy wbTarget.Worksheets(i + 1)
  wbTarget.Worksheets(i + 1).UsedRange.Value = wbTarget.Worksheets(i + 1).UsedRange.Value
Next i
While wbTarget.Worksheets.Count > UBound(worksheetArr) + 1
  Application.DisplayAlerts = False
  wbTarget.Worksheets(wbTarget.Worksheets.Count).Delete
Wend
MsgBox "Export complete.", vbInformation

CleanObject:
    Set wbSource = Nothing
    Set wbTarget = Nothing

Exit Sub

errHandle:
MsgBox "Error: " & Err.Description, vbExclamation

End Sub

1) corrected Dim worksheetArr As Variant
2) added assigning values in used range as values (this is equivalent to copy and paste special as values only) in each of copied worksheets
3) while - wend loop is optional. it removes all empty worksheets you'd have in newly created file (current standard is just Sheet1, but one can chenge the number of worksheets in options).
4) just in case 3rd above is used, I changed place where new sheets are added (again in standard situation - 1 sheet in new workbook it will be exactly the samme as original solution)

Many thanks, this was exactly what I needed! Cheers!

 

[Kaper]

Glad to hear that.
Would be lovely if you mark my post as a solution - see: Mark as Solution

 

[Kaper]

Thanks!

 

[GVR16]

Thanks!

Hi again! I've used this successfully for the past days, however I ran into this error today:

The macro isn't exporting both sheets anymore, just one of them (Orders); the second one (Sales YTD) is missing from the exported file, and instead of it there's a blank worksheet. Not sure if the number of rows has anything to do with it (over 60.000)? Thanks in advance for any advice!

 

[Kaper]

I couldn't obtain such error even with 120 000+ lines in some 40 columns. Excel 365 32 bit. It took pretty long - may be a minute (?) but was successful.

Anyway, if the problem is just because too many rows of data, you may try such moodification:

Sub ExportWorkSheets()

Dim wbSource As Workbook, wbTarget As Workbook
Dim worksheetList As String
Dim worksheetArr As Variant 'correct this line
Dim i As Long
'added line
Dim lastrow As Long, j As Long, tmp As Variant

On Error GoTo errHandle
worksheetList = "Orders;Sales YTD"
worksheetArr = Split(worksheetList, ";")

If UBound(worksheetArr) = -1 Then Exit Sub

Set wbSource = ThisWorkbook
Set wbTarget = Workbooks.Add

For i = LBound(worksheetArr) To UBound(worksheetArr)
  wbSource.Worksheets(worksheetArr(i)).Copy wbTarget.Worksheets(i + 1)
  
'changed part
  With wbTarget.Worksheets(i + 1)
    tmp = Split(.UsedRange.Address(1, 1), "$")
    lastrow = CLng(tmp(UBound(tmp)))
    j = 1
    While j <= lastrow
      With Intersect(.UsedRange, .Rows(j & ":" & j + 9999))
        .Value = .Value
      End With
      j = j + 10000
    Wend
  End With
'end of changed part
Next i
While wbTarget.Worksheets.Count > UBound(worksheetArr) + 1
  Application.DisplayAlerts = False
  wbTarget.Worksheets(wbTarget.Worksheets.Count).Delete
Wend
MsgBox "Export complete.", vbInformation

CleanObject:
    Set wbSource = Nothing
    Set wbTarget = Nothing

Exit Sub

errHandle:
MsgBox "Error: " & Err.Description, vbExclamation

End Sub

 

[GVR16]

I couldn't obtain such error even with 120 000+ lines in some 40 columns. Excel 365 32 bit. It took pretty long - may be a minute (?) but was successful.

Anyway, if the problem is just because too many rows of data, you may try such moodification:

Sub ExportWorkSheets()

Dim wbSource As Workbook, wbTarget As Workbook
Dim worksheetList As String
Dim worksheetArr As Variant 'correct this line
Dim i As Long
'added line
Dim lastrow As Long, j As Long, tmp As Variant

On Error GoTo errHandle
worksheetList = "Orders;Sales YTD"
worksheetArr = Split(worksheetList, ";")

If UBound(worksheetArr) = -1 Then Exit Sub

Set wbSource = ThisWorkbook
Set wbTarget = Workbooks.Add

For i = LBound(worksheetArr) To UBound(worksheetArr)
  wbSource.Worksheets(worksheetArr(i)).Copy wbTarget.Worksheets(i + 1)
 
'changed part
  With wbTarget.Worksheets(i + 1)
    tmp = Split(.UsedRange.Address(1, 1), "$")
    lastrow = CLng(tmp(UBound(tmp)))
    j = 1
    While j <= lastrow
      With Intersect(.UsedRange, .Rows(j & ":" & j + 9999))
        .Value = .Value
      End With
      j = j + 10000
    Wend
  End With
'end of changed part
Next i
While wbTarget.Worksheets.Count > UBound(worksheetArr) + 1
  Application.DisplayAlerts = False
  wbTarget.Worksheets(wbTarget.Worksheets.Count).Delete
Wend
MsgBox "Export complete.", vbInformation

CleanObject:
    Set wbSource = Nothing
    Set wbTarget = Nothing

Exit Sub

errHandle:
MsgBox "Error: " & Err.Description, vbExclamation

End Sub

Many thanks, Kaper! The error is not persistent, so now I'm not convinced it's due to the number of rows either. I will try your solution if it happens again.