copy column width using SpecialCells

[Danny54]

Still struggling a bit. I can run the code below but the target workbooks columns are not sized the same as the primary sheet. There seems to be many ways to copy so i think im trying to mix them is why i keep getting a object error.

Any suggestion would be helpful

in the code below i've commented out the offending line - my attempt - so the macro will run

'data_sh.usedRange.SpecialCells(xlCellTypeVisible).ColumnWidth.Copy nsh.Range("A1")

Thanks

Sub Split_Data_in_Workbooks()


Application.ScreenUpdating = False


Dim usedRange As Range


Dim data_sh As Worksheet
Set data_sh = ThisWorkbook.Sheets("Data")


Dim setting_Sh As Worksheet
Set setting_Sh = ThisWorkbook.Sheets("Settings")


Dim nwb As Workbook
Dim nsh As Worksheet


'''' Get unique supervisors


setting_Sh.Range("A:A").Clear
data_sh.AutoFilterMode = False
data_sh.Range("B:B").Copy setting_Sh.Range("A1")


setting_Sh.Range("A:A").RemoveDuplicates 1, xlYes


Dim i As Integer


For i = 2 To Application.CountA(setting_Sh.Range("A:A"))


    data_sh.usedRange.AutoFilter 2, setting_Sh.Range("A" & i).Value
    
    Set nwb = Workbooks.Add
    Set nsh = nwb.Sheets(1)
    
    data_sh.usedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
    
    'data_sh.usedRange.SpecialCells(xlCellTypeVisible).ColumnWidth.Copy nsh.Range("A1")  'Danny'
         
    nwb.SaveAs setting_Sh.Range("H6").Value & "/" & setting_Sh.Range("A" & i).Value & ".xlsx"
    nwb.Close False
    data_sh.Range("A:A").Clear


Next i


setting_Sh.Range("A:A").Clear
data_sh.AutoFilterMode = False


MsgBox "Done"


End Sub

 

[James006]

Hello,

Why not :

sh.Range("A1")EntireColumn.Autofit<code class="plain"></code>

Hope this will help