Pasting data to first free row in sheet

S

skippy

I currently have some data in one sheet that i want to paste to anothe
sheet programmatically. I can copy the data from the original sheet bu
i am having problems finding the next free cell to paste after i hav
done the original paste to Cell A2.

Any help would be greatly appreciated.


Thanks.

See Section denoted by ~~~~~~~~~~~


Sub CopyBuysAndSells()

Columns("A:M").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending
Key2:=Range("D1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1
MatchCase:= _
False, Orientation:=xlTopToBottom

Range("D2").Select

Do Until ActiveCell = ""
'' check value of active cell
If ActiveCell Like "Buy" Then
'' select entire row
ActiveCell.Rows("1:1").EntireRow.Select
''' copy row
Selection.Copy
Sheets("Buys").Select
'' First time we select the first space available in the range
Range("A2").Select
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
''' need to iterate selection by 1 each time so not pasting ove
previous information

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

ActiveSheet.Paste
''' go back to orginial sheet
Sheets("VTAnalysis").Select
''' move down one row from last check
ActiveCell.Offset(1, 3).Select
Else

If ActiveCell Like "Sell" Then
'' check value of active cell
ActiveCell.Rows("1:1").EntireRow.Select

Selection.Copy
Sheets("Sells").Select
Range("A2").Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("VTAnalysis").Select
ActiveCell.Offset(1, 3).Select

Else
'' move down to next selection
ActiveCell.Offset(1, 0).Select
End If
End If
Loop

Sheets("Summary").Select
Range("B1").Select



End Su
 
T

Tamara

I was surprised how hard it was to find a simple answer to that
question. I found something like this from a previous post.

Public Function GetNextRow()
Dim x As Integer
x = Sheets("DATA").UsedRange.Rows.Count + 1
Cells(x, 1).Select
ActiveCell = "Paste Copied Data"
End Function
 
S

skippy

Thanks Tamara that works perfectly. I tweaked it a little so th
complete code now looks like this.

You will note that i have added an extra function which is because on
of 2 decisions to make when selecting which sheet to go to.I have als
inlcuded a delete row statement as i am uploading all the time t
these sheets and the function keeps adding them at the bottom of th
last entry if i don't clear these down.

Public Function GetNextRow()

Dim x As Integer
x = Sheets("Buys").UsedRange.Rows.Count + 1
Cells(x, 1).Select
End Function

Public Function GetNextSellRow()

Dim x As Integer
x = Sheets("Sells").UsedRange.Rows.Count + 1
Cells(x, 1).Select



End Function



Sub CopyBuysAndSells()

''' clear previous data
Sheets("Buys").Select
'''Range("A2:M900").Select
Rows("2:1000").Select
Selection.Delete
''' clear previous data
Sheets("Sells").Select
Rows("2:1000").Select
'''Range("A2:M900").Select
Selection.Delete
Sheets("VTAnalysis").Select

Columns("A:M").Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending
Key2:=Range("C2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1
MatchCase:= _
False, Orientation:=xlTopToBottom

Range("D2").Select

Do Until ActiveCell = ""
'' check value of active cell
If ActiveCell Like "Buy" Then
'' select entire row
ActiveCell.Rows("1:1").EntireRow.Select
''' copy row
Selection.Copy
Sheets("Buys").Select
''' added new function to locate next available row
GetNextRow
ActiveSheet.Paste
''' go back to orginial sheet
Sheets("VTAnalysis").Select
''' move down one row from last check
ActiveCell.Offset(1, 3).Select
Else

If ActiveCell Like "Sell" Then
'' check value of active cell
'' select entire row
ActiveCell.Rows("1:1").EntireRow.Select
''' copy row
Selection.Copy
Sheets("Sells").Select
''' added new function to locate next available row
GetNextSellRow
''' need to iterate selection by 1 each time so not pasting ove
previous information
ActiveSheet.Paste
''' go back to orginial sheet
Sheets("VTAnalysis").Select
''' move down one row from last check
ActiveCell.Offset(1, 3).Select
Else
'' move down to next selection
ActiveCell.Offset(1, 0).Select
End If
End If
Loop

Sheets("Summary").Select
Range("B1").Select



End Su
 
Top