copying all columns including hidden

[mccabe2017]

How can I modify the following to copy over all columns from source sheet, including hidden columns? Code below takes worksheet and splits data out into different worksheets based on values in one column. However my source worksheet has hidden columns and only visable columns are being pasted. Many thanks from a rial by fire newbie in VBA!!!

Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 59
Set ws = Sheets("Full Data Sheet")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:C1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

[Bob Phillips]

Can you post a sample workbook?

[p45cal]

Since you're using .Copy Destination this keeps all the formats of the cells, but this only copies visible cells in a filtered range, as you've found. Sticking with that, I suggest unhiding all the columns before copying and reinstating hidden columns afterwards.
Try some tweaks along these lines:

Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer

vcol = 59
Set ws = Sheets("Full Data Sheet")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:BZ1"  '"A1:C1" I needed this change to get whole range to autofilter.
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count

'ws.Cells(1, icol) = "Unique"
'For i = 2 To lr
'  On Error Resume Next
'  If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
'    ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
'  End If
'Next

'the above commented-out loop can be replaced by the following 2 lines:
ws.Range(ws.Cells(1, vcol), ws.Cells(lr, vcol)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Cells(1, icol), Unique:=True
ws.Columns(icol).Sort key1:=ws.Cells(1, icol), Header:=xlYes

myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
Set WidthsSht = Sheets.Add  'add a temporary sheet to store column widths.
ws.Rows(1).Copy
WidthsSht.Rows(1).PasteSpecial xlPasteColumnWidths  'paste only the column widths to the new sheet.
ws.Columns.Hidden = False  'unhide all columns on the Full Data sheet so that all are copied.
For i = 2 To UBound(myarr)
  ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""

  If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
    Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
  Else
    Sheets(myarr(i) & "").Move After:=Worksheets(Worksheets.Count)  'why do you do this move??
  End If
  ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
  'Sheets(myarr(i) & "").Columns.AutoFit ' your original code or…
  'to get the new sheets to take on the same column widths/hidden columns as the full data sheet use the next 2 lines:
  WidthsSht.Rows(1).Copy
  Sheets(myarr(i) & "").Rows(1).PasteSpecial xlPasteColumnWidths
Next

ws.AutoFilterMode = False
WidthsSht.Rows(1).Copy  'copy the column widths from the temporary sheet.
ws.Rows(1).PasteSpecial xlPasteColumnWidths  'paste only the widths to restore the columns to their original widths/hidden or not.
Application.DisplayAlerts = False: WidthsSht.Delete: Application.DisplayAlerts = True  'delete the temporary sheet.
ws.Activate
End Sub

There are other techniques you could use to achieve the same/similar result including using an Advanced Filter, which would allow you to specify exactly which columns are copied over (if you don't want all of them).
Also, single a pivot table may give you what you want on a single sheet, just choosing which records you want to see with a dropdown and/or a slicer.