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]

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?

Not a problem. Just you need to make sure you have right coding to read from that textbox. Refer to the link I provided previously

 

[Kenor]

Which part I need to change if I want key in Row number instead of key in first address ?


Private Sub TextBox1_Change()

Dim My_Activesheet As Variant
Dim Last_Row As Long
Dim my_range As Range
Dim c As Variant
Dim firstaddress As Variant
Dim Last_Copied_Row As Long
Dim Records_Copied As Integer

'check if something to search for.
If Trim(ActiveSheet.TextBox1.Text) = "" Then
MsgBox "Nothing to search for"
Exit Sub
End If

Set My_Activesheet = ActiveSheet

'add IN sheet.
On Error Resume Next
Worksheets("IN").Name = "IN"
If Err.Number = 9 Then
Worksheets.Add After:=Sheets(Sheets.Count)
Worksheets(Sheets.Count).Name = "IN"
Worksheets("IN").Range("A3").Value = "IN"
End If
On Error GoTo 0

My_Activesheet.Activate

Last_Row = ActiveSheet.Range("A65536").End(xlUp).Row
If Last_Row = 2 Then
MsgBox ("No Rows of Data could be found to search")
Exit Sub
End If

'exclude headers from used range
Set my_range = ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1)

'find data and copy
Records_Copied = 0
With my_range
Set c = .Find(ActiveSheet.TextBox1.Value, LookIn:=xlValues, searchorder:=xlByRows)
If Not c Is Nothing Then
firstaddress = c.Address
Last_Copied_Row = 0
Do
If Last_Copied_Row <> c.Row Then 'check to make sure row not already copied
c.EntireRow.Copy Destination:=Worksheets("IN").Range("A" & Worksheets("IN").Range("A65536").End(xlUp).Row + 1)
Records_Copied = Records_Copied + 1
Last_Copied_Row = c.Row
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With

'display results
If Records_Copied = 0 Then
MsgBox "No Search Results Found"
Else
MsgBox "Copied over " & Records_Copied & " records to IN sheet"
End If

End Sub

 

[Zot]

I did not get it. What do you mean by first address?

Your code immediately run if any single is pressed, right? You cannot even enter double digit row number for example since immediately after change is detected in TextBox1 the program continue with the rest of the code. You probably do not want to tun anything until you finish key in number in TextBox1.

Maybe you want to add OK or RUN button instead, execute program after add necessary data in keyed in.

 

[Kenor]

Yes, exactly!
You got what I mean.

I have create one Button and try to make link with the TextBox1 but didn't work...

 

[Zot]

Yes, exactly!
You got what I mean.

I have create one Button and try to make link with the TextBox1 but didn't work...

With my_range
   Set c = .Find(ActiveSheet.TextBox1.Value, LookIn:=xlValues, searchorder:=xlByRows)
   If Not c Is Nothing Then
       firstaddress = c.Address
       Last_Copied_Row = 0
       Do
           If Last_Copied_Row <> c.Row Then 'check to make sure row not already copied
               c.EntireRow.Copy Destination:=Worksheets("IN").Range("A" & Worksheets("IN").Range("A65536").End(xlUp).Row + 1)
               Records_Copied = Records_Copied + 1
               Last_Copied_Row = c.Row
           End If
           Set c = .FindNext(c)
       Loop While Not c Is Nothing And c.Address <> firstaddress
   End If
End With

The ActiveSheet.TextBox1.Value did read the value in ActiveX TextBox, but what are you trying to find on worksheet? There is no TextBox number on worksheet, right? So, no range c was found.
You already capture the row number specified in TextBox, then just use it. Why need to search?

It should be
If Last_Copied_Row <> ActiveSheet.TextBox1.Value

or you can assign a variable to it to simplify. You can try put x= ActiveSheet.TextBox1.Value in your code and you will find x=to TextBox number you entered.