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

 

[Zot]

I see that you have many sheets and one is Database. I presumed that you want to copy data on other sheets to Database.

In this case, you do not need to rename worksheet in the program all the time.

Sub Rectangle1_Click()

Dim wsData As Worksheet
Dim wsDatabase As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long

Set wsData = ActiveSheet
Set wsDatabase = Worksheets("Database")

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

wsData.Range("A4", "G" & CopyLastRow).Copy Destination:=wsDatabase.Range("A4" & DestLastRow)
wsData.Range("A4", "A" & CopyLastRow).EntireRow.Delete

So, once you are on the worksheet you want to copy, you can just run the program and the data will be copied to Database. The problem now is that you have your button on other worksheet. The easy solution is to put the program in standard module and name the program as Sub <any name>. When you want to tun the program just press Alt+F8 and select the program name you created.

 

[Kenor]

Yes, my mistake...I already change it..thanks

But I have i more question...

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.

 

[Kenor]

I see that you have many sheets and one is Database. I presumed that you want to copy data on other sheets to Database.

In this case, you do not need to rename worksheet in the program all the time.

Sub Rectangle1_Click()

Dim wsData As Worksheet
Dim wsDatabase As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long

Set wsData = ActiveSheet
Set wsDatabase = Worksheets("Database")

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

wsData.Range("A4", "G" & CopyLastRow).Copy Destination:=wsDatabase.Range("A4" & DestLastRow)
wsData.Range("A4", "A" & CopyLastRow).EntireRow.Delete

So, once you are on the worksheet you want to copy, you can just run the program and the data will be copied to Database. The problem now is that you have your button on other worksheet. The easy solution is to put the program in standard module and name the program as Sub <any name>. When you want to tun the program just press Alt+F8 and select the program name you created.

Yes that right!

I will try it later...but could u help to solve another 1 problem.

I already post it just now.

Btw, thanks a lot for your help and great idea...

 

[Zot]

Yes, my mistake...I already change it..thanks

But I have i more question...

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.

So now that you have a possibility of headers not in same sequence or additional headers. Then I think the program need re-writing. Maybe later. Busy at the moment.

Quick solution is that just re-arrange the headers to make them in sequence ?

 

[Kenor]

Ok, I will try it first.

If you free, hope u can try to re-writing the program to me.

Thanks

 

[Zot]

How to run code?
1) Click run button and pop-up userform to select data worksheet. Click Continue to run
2) Create run button on each data worksheets to link to same program

For simplification and require no more creation of Userform Continue and additional code, let's choose 2nd approach.

1) Install the program in standard VBA module
2) Insert shape for Button on data sheets. Right click and assign the same macro to each of the sheet.

Sub TransferData()

Dim colData$, colDBase$
Dim ArryHeaderDBase() As Variant, ArryColDBase() As Variant
Dim n&, CopyLastRow&, DestLastRow&
Dim cell As Range, rngDataHeader As Range
Dim wb As Workbook
Dim wsData As Worksheet, wsDatabase As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wb = ThisWorkbook
Set wsData = wb.ActiveSheet
Set wsDatabase = wb.Sheets("Database")

ArryHeaderDBase = Array("Date", "Time", "ID", "Alloy", "Recycle Material", "IN (kg)", "OUT (kg)", "PIC")
ArryColDBase = Array("A", "B", "C", "D", "E", "F", "G", "H")

Set rngDataHeader = wsData.Range(Cells(3, 1), Cells(3, wsData.Cells(3, wsData.Columns.Count).End(xlToLeft).Column))

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

' Find matching Data and Database columns and copy/delete data from Data to Database column by column
For n = 0 To UBound(ArryHeaderDBase)
    colDBase = ArryColDBase(n)
    For Each cell In rngDataHeader
        If cell = ArryHeaderDBase(n) Then
            colData = Split(cell.Address, "$")(1)
            wsData.Range(colData & "4", colData & CopyLastRow).Copy Destination:=wsDatabase.Range(colDBase & DestLastRow)
            wsData.Range(colData & "4", colData & CopyLastRow).ClearContents
            Exit For
        End If
    Next
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[Kenor]

Thank you

I will try to apply your program.

 

[Kenor]

I want to ask,

Is it I can create text box and command button in rectangle as attached image to transfer data?

 

[Zot]

I want to ask,

Is it I can create text box and command button in rectangle as attached image to transfer data?

This rectangle is from Insert>Shape? Not sure why you want you want to do that. Any shape you can assign a macro to run upon clicking it, I think. Now you put a Command Button (I presumed ActiveX) onto the shape. What is it for?

If the rectangular is just to provide background color, then you can just run macro by clicking the CommandButton. To get value from TextBox created on sheet using normal TextBox or ActiveX TextBox is different. Refer this

ActiveX textbox value

How do I get the value of a textbox in Word? I know in excel this is the right syntax: ActiveSheet.Shapes(x).Name. I thought in word this would be the right syntax ActiveDocument.Shapes(x).N...

stackoverflow.com

It is good idea also if you just need to key in sheet name in textbox for the sheet to want to copy. This way you have only one button to run the program.

 

[Kenor]

Yes, this rectangle is from Insert>Shape. I actually want to put text box and command button inside this rectangle . So that, I just need to key in row number in text box for select data that I want to transfer.

I'm not sure. Is it can do that?