PDA

View Full Version : Solved: PasteSpecial and Selection Areas



mdmackillop
04-09-2008, 03:50 PM
Sub TestCopy()
For i = 2 To Sheets.Count
Sheets(1).UsedRange.Copy
Sheets(i).Range("A1").PasteSpecial xlValues
Next
Application.CutCopyMode = False
End Sub
Running this code leaves the UsedRange area selected in sheets 2, 3 etc. Is there a way to make only A1 the selection area without activating each sheet and selecting the cell as below?


Sub TestCopy2()
For i = 2 To Sheets.Count
Sheets(1).UsedRange.Copy
Sheets(i).Range("A1").PasteSpecial xlValues
Sheets(i).Activate
Range("A1").Select
Next
Sheets(1).Activate
Application.CutCopyMode = False
End Sub

malik641
04-09-2008, 06:56 PM
I don't like using variants.....but:

Option Explicit

Sub TestCopy()
Dim i As Integer, iDims As Byte
Dim myArr As Variant

myArr = Sheets(1).UsedRange
If IsEmpty(myArr) Then Exit Sub

iDims = NumberOfArrayDimensions(myArr)

For i = 2 To Sheets.Count
Sheets(i).Range("A1").Resize(UBound(myArr, 1), UBound(myArr, iDims)) = myArr
Next
End Sub


' FOLLOWING IS FROM: http://www.cpearson.com/excel/VBAArrays.htm
Public Function NumberOfArrayDimensions(Arr As Variant) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''
' NumberOfArrayDimensions
' This function returns the number of dimensions of an array. An unallocated dynamic array
' has 0 dimensions. This condition can also be tested with IsArrayEmpty.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
' Loop, increasing the dimension index Ndx, until an error occurs.
' An error will occur when Ndx exceeds the number of dimension
' in the array. Return Ndx - 1.
Do
Ndx = Ndx + 1
Res = UBound(Arr, Ndx)
Loop Until Err.Number <> 0

NumberOfArrayDimensions = Ndx - 1

End Function
Second function courtesy of: http://www.cpearson.com/excel/VBAArrays.htm

tstav
04-10-2008, 02:21 AM
Sub TestCopy()
Dim i As long
With Sheets(1).UsedRange
For i = 2 To Sheets.count
Sheets(i).Range("A1").Resize(.Rows.count, .Columns.count).Value = .Value
Next
End With
End Sub


It doesn't select A1 on each Sheet but it leaves no areas highlighted.

malik641
04-10-2008, 05:26 AM
Sub TestCopy()
Dim i As long
With Sheets(1).UsedRange
For i = 2 To Sheets.count
Sheets(i).Range("A1").Resize(.Rows.count, .Columns.count).Value = .Value
Next
End With
End Sub

It doesn't select A1 on each Sheet but it leaves no areas highlighted.
Nice! :yes

mdmackillop
05-05-2008, 01:47 AM
Joseph,
A bit "heavier" that i would like just to tidy up.

Tstav,
Neat, but a bit restrictive if i want to copy more than values.

It finally occurred to be just to do another PasteSpecial.

Sub test()
For Each sh In Worksheets
Tidy sh
Next
End Sub

Sub Tidy(sh As Worksheet)
sh.Range("A1").Copy
sh.Range("A1").PasteSpecial xlPasteAll
End Sub