flightjock
New Member
- Joined
- Mar 18, 2002
- Messages
- 48
I'm using the VBA code posted some time ago to copy column width and row height to another worksheet with much success. This code also copies the contet of the cells. However when graphical objects are in the sheet such as charts, buttons they are not copied. It would be a great help if somebody could give some help to extend the VBA to also copy these graphical objects at the same time.
It would even be more helpful if any chart series references after the copying operation would now point to the new sheet and no longer to the original sheet. Any help would be greatly appreciated since we use this kind of operation very often.
The current VBA which just copies content and columns/rows is as follows:
Sub CopyWithRowAndColwidths()
Dim ICount 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
rngPaste.Cells(1, 1).PasteSpecial xlPasteAll
For ICount = 1 To rngCopy.Columns.Count
rngPaste.Cells(1, ICount).ColumnWidth = _
rngCopy.Columns(ICount).ColumnWidth
Next ICount
For ICount = 1 To rngCopy.Rows.Count
rngPaste.Cells(ICount, 1).RowHeight = _
rngCopy.Rows(ICount).RowHeight
Next ICount
Application.CutCopyMode = False
End If
End If
End Sub
It would even be more helpful if any chart series references after the copying operation would now point to the new sheet and no longer to the original sheet. Any help would be greatly appreciated since we use this kind of operation very often.
The current VBA which just copies content and columns/rows is as follows:
Sub CopyWithRowAndColwidths()
Dim ICount 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
rngPaste.Cells(1, 1).PasteSpecial xlPasteAll
For ICount = 1 To rngCopy.Columns.Count
rngPaste.Cells(1, ICount).ColumnWidth = _
rngCopy.Columns(ICount).ColumnWidth
Next ICount
For ICount = 1 To rngCopy.Rows.Count
rngPaste.Cells(ICount, 1).RowHeight = _
rngCopy.Rows(ICount).RowHeight
Next ICount
Application.CutCopyMode = False
End If
End If
End Sub