Column width in VBA

[Wongjim]

Hi
I have a VBA script were a range of cells are saved in a new xlsx file. The VBA script works fine on only one thing.
How do I save also the column width and row height from the original file to the saved file?

At this moment I have this script:

Option Explicit


Sub SaveXLSX()
Dim Filename As Variant
Dim Wb As Workbook
Dim Source As Range, Dest As Range

With Blad1
'Refer to the data cells
Set Source = .Range("A1:K10")
'Build the file name (same result as your code, just to show another way)
'Filename = Join(Array(.Range("P29"), .Range("P30"), .Range("P31")))
Filename = Range("A2")
End With
'Ask the user
Filename = Application.GetSaveAsFilename(Filename, "Excelfile (*.xlsx), *.xlsx")
'Aborted?
If VarType(Filename) = vbBoolean Then Exit Sub
'Create a new file
Set Wb = Workbooks.Add(xlWBATWorksheet)
'Refer to the destination cell
Set Dest = Wb.Sheets(1).Range("A1")

'Copy the cells
Source.Copy Dest
'Alternatively to remove the formulas if any:
'Source.Copy
'Dest.PasteSpecial xlPasteValuesAndNumberFormats

'Save the file
Wb.SaveAs Filename
'Application.ScreenUpdating = True
End Sub

 

[Fluff]

Hi & welcome to MrExcel.
Are the column widths & row heights all the same, or can they vary?

 

[Wongjim]

Hi Fluff,
They vary
Columns were the width and height reply to are "A1" tot "G71"

Thanks for helping out...

 

[Fluff]

Try

Sub SaveXLSX()
Dim Filename As Variant
Dim Wb As Workbook
Dim Source As Range, Dest As Range
[COLOR=#0000ff]Dim Col As Range, Rw As Range[/COLOR]

With Sheet3
'Refer to the data cells
Set Source = .Range("A1:K10")
'Build the file name (same result as your code, just to show another way)
'Filename = Join(Array(.Range("P29"), .Range("P30"), .Range("P31")))
Filename = Range("A2")
End With
'Ask the user
'Filename = Application.GetSaveAsFilename(Filename, "Excelfile (*.xlsx), *.xlsx")
'Aborted?
If VarType(Filename) = vbBoolean Then Exit Sub
'Create a new file
Set Wb = Workbooks.Add(xlWBATWorksheet)
'Refer to the destination cell
Set Dest = Wb.Sheets(1).Range("A1")

'Copy the cells
Source.Copy Dest
[COLOR=#0000ff]For Each Col In Source.Columns
   Dest.Offset(, Col.Column - 1).ColumnWidth = Col.ColumnWidth
Next Col
For Each Rw In Source.Rows
   Dest.Offset(Rw.Row - 1).RowHeight = Rw.Height
Next Rw[/COLOR]
'Alternatively to remove the formulas if any:
'Source.Copy
'Dest.PasteSpecial xlPasteValuesAndNumberFormats

'Save the file
Wb.SaveAs Filename
'Application.ScreenUpdating = True
End Sub

 

[Wongjim]

Thanks Fluff
Worked like a charm!

how the heck did you find the answer that quick? I search the forums before registering for days!!!

BR
Jim

 

[Fluff]

Glad to help & thanks for the feedback.