Copy all data to another sheet without select any range and clear the original contents

[Kenor]

Hi guys,
Sorry actually I'm not so familiar with VBA code.
I want to transfer data from worksheet 'Register' to worksheet 'Database' in same workbook.
I would like to have Transfer button. So, when I click the Transfer button all data from worksheet 'Register' will paste on next blank row in worksheet 'Database' and clear the original contents.
I have some code below. But let say I want all data transfer automatically in worksheet 'Database' without mention specific Range.
Means, I want to transfer all available data. For example, today will transfer data from A2:E5 but tomorrow maybe need to transfer data A2:E10. Everyday data might not in specific range.

Anybody can help me. I'm not sure how to modify below code as per I mention above.


Sub CopyPasteBelowLastCell()
'
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

Set wsCopy = Worksheets("Register")
Set wsDest = Worksheets("Database")

Range("A2:D9").Select
Selection.Copy
Sheets("Database").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Register").Select
Range("A2:D9").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D17").Select

End Sub

 

[Kenor]

1st time click transfer button, all data has been moved.

 

[Kenor]

But after 2nd time I click transfer button, the header also moved.

 

[Zot]

Should be something like this?

Sub TransferData()

Dim wsExport As Worksheet
Dim wsSummary As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long

Set wsExport = Worksheets("Export")
Set wsSummary = Worksheets("Summary")

CopyLastRow = wsExport.Range("A2").End(xlDown).Row              ' Find last row od Export sheet
DestLastRow = wsSummary.Range("A2").End(xlDown).Row + 1     ' Find next blank row in Summary sheet

wsExport.Range("A2", "D" & CopyLastRow).Copy Destination:=wsSummary.Range("A" & DestLastRow)
Application.CutCopyMode = False                                              ' I think you do not need this line also since you will delete
wsExport.Range("A2", "A" & CopyLastRow).EntireRow.Delete

End Sub

 

[Kenor]

I will try it first.

Thank you..... Will let you know later.

 

[Kenor]

Sub TransferData()

Dim wsExport As Worksheet
Dim wsSummary As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long

Set wsExport = Worksheets("Export")
Set wsSummary = Worksheets("Summary")

CopyLastRow = wsExport.Range("A2").End(xlDown).Row
DestLastRow = wsSummary.Range("A2").End(xlDown).Row + 1

wsExport.Range("A2", "D" & CopyLastRow).Copy Destination:=wsSummary.Range("A" & DestLastRow) ---> Error 1004 (What I need to do?)
Application.CutCopyMode = False
wsExport.Range("A2", "A" & CopyLastRow).EntireRow.Delete

End Sub

 

[Zot]

My mistake. Did not test since I was rushing with work. Sorry

DestLastRow = wsSummary.Range("A2").End(xlDown).Row + 1 give end of worksheet row since there is no data. I should go from bottom up

Replace:

CopyLastRow = wsExport.Range("A2").End(xlDown).Row
DestLastRow = wsSummary.Range("A2").End(xlDown).Row + 1

with:

CopyLastRow = wsExport.Range("A" & wsExport.Rows.Count).End(xlUp).Row + 1
DestLastRow = wsSummary.Range("A" & wsSummary.Rows.Count).End(xlUp).Row + 1

 

[Kenor]

Well done ???
Thank you so much Zot for your help and guidance. ?

 

[Kenor]

I'm sorry,

I try to use same code for other workbook but I change the Row number. Is it correct?

I want transfer data from sheet "IN" to sheet"Database" but when I click Transfer button, error 424.

Could I know what happen on below code?


Sub Rectangle1_Click()

Dim wsIN As Worksheet
Dim wsDatabase As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long

Set wsIN = Worksheets("IN")
Set wsDatabase = Worksheets("Database")

CopyLastRow = wsIN.Range("A" & wsIN.Rows.Count).End(xlUp).Row + 1
DestLastRow = wsDatabase.Range("A" & wsDatabase.Rows.Count).End(xlUp).Row + 1

wsIN.Range("A4", "G" & CopyLastRow).Copy Destination:=wsSummary.Range("A4" & DestLastRow) ----> error 424
wsIN.Range("A4", "A" & CopyLastRow).EntireRow.Delete


End Sub

 

[Kenor]

Owh sorry my mistake..

Its work already.

But how to ensure all data will transfer according to correct header title?

Let say data in column "IN (Kg)" from sheet IN will transfer into column "IN (Kg)" in sheet Database.


See attached image.

 

[Zot]

You have worksheet name Database referred to wsDatabase, but the destination worksheet is pointing to wsSummary