Macro required to copy -past data to first empty row

  • Thread starter Thread starter Vikky
  • Start date Start date
V

Vikky

Hi Expert,

I am in need of such a macro or code by which I can copy & paste data
from a particular row to first empty row of given row range.

Kindly help.

Regards,
Vikky
 
Hi Vikky

Give more information

Do you want to copy a row (fixed row or selected row ?) to another sheet or in the same sheet below other data ?
 
Hi Vikky

Give more information

Do you want to copy a row (fixed row or selected row ?) to another sheet or in the same sheet below other data ?

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm









- Show quoted text -

Hi Ron,

Yes, I want to copy a fixed row to in the same sheet below other
data.

Regards,

Vikky
 
Copy the macro and function in a normal module
Alt F11
Insert module
Paste it in the module
Alt q to go back to Excel

This example copy row 1 from the sheet "Sheet1" to the first empty row on the worksheet "Sheet1"
You can run the macro with Alt-F8 or add a button on your sheet to run the macro

Sub copy_3_Values_PasteSpecial()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Application.ScreenUpdating = False
Lr = LastRow(Sheets("Sheet1")) + 1
Set sourceRange = Sheets("Sheet1").Rows("1:1")
Set destrange = Sheets("Sheet1").Rows(Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
 
Copy the macro and function in a normal module
Alt F11
Insert module
Paste it in the module
Alt q to go back to Excel

This example copy row 1 from the sheet "Sheet1" to the first empty row on the worksheet "Sheet1"
You can run the macro with Alt-F8 or add a button on your sheet to run the macro

Sub copy_3_Values_PasteSpecial()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Application.ScreenUpdating = False
Lr = LastRow(Sheets("Sheet1")) + 1
Set sourceRange = Sheets("Sheet1").Rows("1:1")
Set destrange = Sheets("Sheet1").Rows(Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm







- Show quoted text -

Hi Ron,

It's Working.:)

Thanks Alot for ur great help. This would save a lot of time of mine.

Once again thanks a lot.

Regards,

Vikky
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top