I have a macro that we use for copying a worksheet into a new workbook. The only issue I am having is that when it copies the worksheet into a new workbook, it copies the hidden columns/rows. What would be the best way to update the macro so that it doesn't copy the hidden columns/rows?
Sub CopySheets()
Dim wkb As Excel.Workbook
Dim newWkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim newWks As Excel.Worksheet
Dim sheets As Variant
Dim varName As Variant
Dim i As Integer
'------------------------------------------------------------
Application.ScreenUpdating = False
'Define the names of worksheets to be copied.
sheets = VBA.Array("TAB NAME")
'Create reference to the current Excel workbook and to the destination workbook.
Set wkb = Excel.ThisWorkbook
Set newWkb = Excel.Workbooks.Add
For Each varName In sheets
'Clear reference to the [wks] variable.
Set wks = Nothing
'Check if there is a worksheet with such name.
On Error Resume Next
Set wks = wkb.Worksheets(VBA.CStr(varName))
On Error GoTo 0
'If worksheet with such name is not found, those instructions are skipped.
If Not wks Is Nothing Then
'Copy this worksheet to a new workbook.
Call wks.Copy(newWkb.Worksheets(1))
'Get the reference to the copy of this worksheet and paste
'all its content as values.
Set newWks = newWkb.Worksheets(wks.Name)
With newWks
Call .Cells.Copy
Call .Range("A1").PasteSpecial(Paste:=xlValues)
Call .Range("A1").Select
End With
End If
'Delete Sheet1 from new workbook
Application.DisplayAlerts = False
For i = newWkb.Worksheets.Count To 2 Step -1
newWkb.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True
Next varName
Application.ScreenUpdating = True
End Sub
Something like this should work:
Sub CopySheets()
Dim wkb As Workbook 'you don't typically use the `Excel.` prefix....
Dim newWkb As Workbook
Dim wks As Worksheet
Dim newWks As Worksheet
Dim sheetsToCopy As Variant, varName As Variant, copied As Long
Application.ScreenUpdating = False
sheetsToCopy = VBA.Array("TAB NAME") 'worksheets to be copied.
Set wkb = ThisWorkbook
Set newWkb = Excel.Workbooks.Add '#ADDED
For Each varName In sheetsToCopy
Set wks = Nothing
On Error Resume Next 'is there a worksheet with this name?
Set wks = wkb.Worksheets(VBA.CStr(varName))
On Error GoTo 0
If Not wks Is Nothing Then
wks.Copy before:=newWkb.Worksheets(1) 'use of `Call` is deprecated...
Set newWks = newWkb.Worksheets(1)
newWks.UsedRange.Value = newWks.UsedRange.Value 'convert to values
DeleteHiddenColsAndRows newWks 'remove hidden rows/columns
copied = copied + 1
If copied = 1 Then 'remove existing sheet after first copy is made
Application.DisplayAlerts = False
newWkb.Worksheets(2).Delete
Application.DisplayAlerts = True
End If
End If
Next varName
Application.ScreenUpdating = True
MsgBox copied & " worksheets were copied", vbInformation + vbOKOnly
End Sub
Sub DeleteHiddenColsAndRows(ws As Worksheet)
Dim rng As Range, rw As Range, col As Range
'loop columns
For Each col In ws.UsedRange.Columns
If col.EntireColumn.Hidden Then BuildRange rng, col.EntireColumn
Next col
If Not rng Is Nothing Then rng.Delete 'deleting in a batch is faster
'loop rows
Set rng = Nothing 'reset range
For Each rw In ws.UsedRange.Rows
If rw.EntireRow.Hidden Then BuildRange rng, rw.EntireRow
Next rw
If Not rng Is Nothing Then rng.Delete
End Sub
'build a range in `rngTot` by adding range `rngAdd`
Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
If rngTot Is Nothing Then
Set rngTot = rngAdd
Else
Set rngTot = Application.Union(rngTot, rngAdd)
End If
End Sub