Retaining Column Width when using macro to split data into separate workbooks

[LeighBarber]

Ive been using the attached macro which i found on these boards and fiddled with a little in order to get it to do what i wanted, which was export filtered data into its own worksheet based on specified criteria, and it works 99% perfectly.

The one thing Im not able to work out how to do it how i get the data created in the new workbooks to retain the column size of the data from the master sheet. Currently it exports and each column is the same default size which is to small.

I would like to either get it to import in the column width of the original data or specify what size i want the columns to be.

Any ideas?

Sub WorkbookNew()
Dim wbNew As Workbook
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRow As Long
   
    Set wsData = Worksheets("Master (2)") ' name of worksheet with the data
    Set wsCrit = Worksheets.Add
   
    LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
   
    ' column H has the criteria
    wsData.Range("H1:H" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
   
    Set rngCrit = wsCrit.Range("A2")
    While rngCrit.Value <> ""
        Set wsNew = Worksheets.Add
        ' change E to reflect columns to copy
        wsData.Range("A1:E" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True
        wsNew.Name = rngCrit
        wsNew.Copy
        Set wbNew = ActiveWorkbook
        ' saves new workbook in path of existing workbook
        wbNew.SaveAs ThisWorkbook.Path & "\" & rngCrit
        wbNew.Close SaveChanges:=True
        Application.DisplayAlerts = False
        wsNew.Delete
        rngCrit.EntireRow.Delete
        Set rngCrit = wsCrit.Range("B2")
    Wend
   
    wsCrit.Delete
    Application.DisplayAlerts = True

End Sub

 

[MrTeeny]

Because you're only copying cells rather than full columns it won't bring across the row heights/column widths etc. Might be easier to just code the default column sizes to be set in your coding rather than trying to get and copy across from the data as it doesn't seem to have many columns. You can set the widths using

[COLOR=#000000][FONT=Menlo]Worksheets([/FONT][/COLOR][COLOR=#A31515][FONT=Menlo]"Sheet1"[/FONT][/COLOR][COLOR=#000000][FONT=Menlo]).Columns([/FONT][/COLOR][COLOR=#A31515][FONT=Menlo]"A"[/FONT][/COLOR][COLOR=#000000][FONT=Menlo]).ColumnWidth = 24 ' etc[/FONT][/COLOR]

 

[LeighBarber]

[COLOR=#000000][FONT=Menlo]Worksheets([/FONT][/COLOR][COLOR=#A31515][FONT=Menlo]"Sheet1"[/FONT][/COLOR][COLOR=#000000][FONT=Menlo]).Columns([/FONT][/COLOR][COLOR=#A31515][FONT=Menlo]"A"[/FONT][/COLOR][COLOR=#000000][FONT=Menlo]).ColumnWidth = 24 ' etc[/FONT][/COLOR]

[/QUOTE]

Thanks for the help, but where in the code would i enter this section?