View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
Ken Johnson Ken Johnson is offline
external usenet poster
 
Posts: 1,073
Default Copy cells from one sheet to the next available row on another?

Hi clarkie,

You haven't supplied any details, so here's my way where the user makes
the decisions on the fly...

Public Sub RowToOtherSheet()
Dim rngDest As Range
Dim rngSubject As Range
Dim lngLastRow As Long
Dim lngLastColumn As Long

On Error GoTo CANCELLED 'handle Cancel press

'Row range to copy
Set rngSubject = Application.InputBox( _
prompt:="Select the leftmost cell of the row to copy.", _
Title:="Copy Row.", _
Default:=Selection.Address, _
Type:=8)
lngLastColumn = Cells(rngSubject.Row, _
Columns.Count).End(xlToLeft).Column
Set rngSubject = ActiveSheet.Range(rngSubject.Cells(1), _
Cells(rngSubject.Cells(1).Row, lngLastColumn))

'Sheet as destination
Set rngDest = Application.InputBox( _
prompt:="Click..." & vbNewLine & "1. Other sheet tab" & _
vbNewLine & "2. Any cell on that sheet" & vbNewLine & _
"3. OK", _
Title:="Destination?", _
Type:=8)

'Next available row on destination sheet relative to col A
With Worksheets(rngDest.Parent.Name)
lngLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rngDest = .Range(.Cells(lngLastRow, 1), _
.Cells(lngLastRow, rngSubject.Columns.Count))
End With

'transfer values
rngDest.Value = rngSubject.Value

'show that code has taken effect
'just delete next line if not necessary
Worksheets(rngDest.Parent.Name).Activate
CANCELLED:
End Sub


Ken Johnson