Macro to paste Column Width doesn't work? Help!

[Cosmos75]

Every time I record a macro to copy a range and then paste the column widths to another range it doesn't work. Here's the code I get?

Selection.PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Is there an alternative way?

[NateO]

Yep, this is a good start:

Sub CopywithRowAndColwidths()
Dim lCount As Long
Dim rngCopy As Range
Dim rngPaste As Range
On Error Resume Next
Set rngCopy = Application.InputBox("Select the range to copy", , , , , , ,
If Not rngCopy Is Nothing Then
Set rngPaste = Application.InputBox("Select the cell to paste to", , , , , , ,
On Error GoTo 0
If Not rngPaste Is Nothing Then
rngCopy.Copy
rngPaste.Cells(1, 1).PasteSpecial xlPasteAll
For lCount = 1 To rngCopy.Columns.Count
rngPaste.Cells(1, lCount).ColumnWidth = _
rngCopy.Columns(lCount).ColumnWidth
Next lCount
For lCount = 1 To rngCopy.Rows.Count
rngPaste.Cells(lCount, 1).RowHeight = _
rngCopy.Rows(lCount).RowHeight
Next lCount
Application.CutCopyMode = False
End If
End If
End Sub


Mix your code in here, play with the xlpasteall, change the input boxes to cell ranges, etc.....

Hope that helps. Cheers,

Nate

[NateO]

Also, change the smileys to "8)" (no quotes). In the time I just typed this I should have put "type:=" in front of it!


Cheers,

Nate

[ This Message was edited by: NateO on 2002-03-13 11:25 ]

[Cosmos75]

NateO,

Thanks! This works but I don't want to what is in the rngCopy, I just want to paste the column widths of rngCopy and not what is in them. How do I modify this to do that?

[NateO]

Jes need to remove one line, which I've taken the liberty of doing below:

Sub CopywithRowAndColwidths2()
Dim lCount As Long
Dim rngCopy As Range
Dim rngPaste As Range
On Error Resume Next
Set rngCopy = Application.InputBox(prompt:="Select the range to copy", Type:=8)
If Not rngCopy Is Nothing Then
Set rngPaste = Application.InputBox(prompt:="Select the cell to paste to", Type:=8)
On Error GoTo 0
If Not rngPaste Is Nothing Then
rngCopy.Copy
For lCount = 1 To rngCopy.Columns.Count
rngPaste.Cells(1, lCount).ColumnWidth = _
rngCopy.Columns(lCount).ColumnWidth
Next lCount
For lCount = 1 To rngCopy.Rows.Count
rngPaste.Cells(lCount, 1).RowHeight = _
rngCopy.Rows(lCount).RowHeight
Next lCount
Application.CutCopyMode = False
End If
End If
End Sub


Hope this helps. Cheers,

Nate

[Ivan F Moala]

On 2002-03-13 10:56, Cosmos75 wrote:
Every time I record a macro to copy a range and then paste the column widths to another range it doesn't work. Here's the code I get?

Selection.PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Is there an alternative way?

change code to;

Selection.PasteSpecial Paste:=8, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


or

something like;

Const xlColumnWidths = 8

Sub PasteSpec_XlColWdth()

Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub


Ivan

[ This Message was edited by: Ivan F Moala on 2002-03-14 23:26 ]