View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
PY & Associates[_2_] PY & Associates[_2_] is offline
external usenet poster
 
Posts: 38
Default Copy cell range to another sheet

On Mar 11, 4:21*pm, Albert wrote:
Hi Guys,

I am looking for some help.

I have a macro that I have adapted from Ron de Bruin. Instead of setting the
SourceRange explicitly I would like to code something like this:

Select Sheets("List").Range("e2") then select until the column is empty and
use that as my SourceRange.

Sub copy_1()
* * Dim SourceRange As Range
* * Dim DestRange1 As Range
* * Dim DestRange2 As Range
* * Dim DestRange3 As Range
* * Dim DestRange4 As Range
* * Dim DestSheet1 As Worksheet, Lr As Long
* * Dim DestSheet2 As Worksheet
* * Dim DestSheet3 As Worksheet
* * Dim DestSheet4 As Worksheet

* * With Application
* * * * .ScreenUpdating = False
* * * * .EnableEvents = False
* * End With

* * 'fill in the Source Sheet and range
* * Set SourceRange = Sheets("Stock Summary").Range("A4:e55")

* * 'Fill in the destination sheet and call the LastRow
* * 'function to find the last row
* * Set DestSheet1 = Sheets("Opening Stock")
* * Lr = LastRow(DestSheet1)
* * Set DestSheet2 = Sheets("Closing Stock")
* * Lr = LastRow(DestSheet2)
* * Set DestSheet3 = Sheets("Purchases")
* * Lr = LastRow(DestSheet3)
* * Set DestSheet4 = Sheets("Usage")
* * Lr = LastRow(DestSheet4)

* * 'With the information from the LastRow function we can
* * 'create a destination cell and copy/paste the source range
* * Set DestRange1 = DestSheet1.Range("A2")
* * SourceRange.Copy DestRange1
* * Set DestRange2 = DestSheet2.Range("A2")
* * SourceRange.Copy DestRange2
* * Set DestRange3 = DestSheet3.Range("A2")
* * SourceRange.Copy DestRange3
* * Set DestRange4 = DestSheet4.Range("A2")
* * SourceRange.Copy DestRange4

' * *Set DestRange1 = DestSheet1.Range("A" & Lr + 1)
' * *SourceRange.Copy DestRange1
' * *Set DestRange2 = DestSheet2.Range("A" & Lr + 1)
' * *SourceRange.Copy DestRange2
' * *Set DestRange3 = DestSheet3.Range("A" & Lr + 1)
' * *SourceRange.Copy DestRange3
' * *Set DestRange4 = DestSheet4.Range("A" & Lr + 1)
' * *SourceRange.Copy DestRange4

* * With Application
* * * * .ScreenUpdating = True
* * * * .EnableEvents = True
* * End With

End Sub

Thanks
Albert


Something like this?

With Sheets("List")
lr = .Range("e2").End(xlDown).Row
Set sourcerng = .Range("e2:e" & lr)
End With