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

Kenor

New Member
Joined
Dec 8, 2020
Messages
46
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Nov 26, 2020
Messages
981
Office Version
  1. 2016
Platform
  1. Windows
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
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

Kenor

New Member
Joined
Dec 8, 2020
Messages
46
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Nov 26, 2020
Messages
981
Office Version
  1. 2016
Platform
  1. Windows
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

New Member
Joined
Dec 8, 2020
Messages
46
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Nov 26, 2020
Messages
981
Office Version
  1. 2016
Platform
  1. Windows
Yes, exactly!
You got what I mean.

I have create one Button and try to make link with the TextBox1 but didn't work...:(
Rich (BB code):
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,347
Messages
5,624,136
Members
416,012
Latest member
rockermom59

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top