Copy /past cells by inputbox on sheet 2 to sheet1 using VBA

Jd1uth

New Member
Joined
Sep 17, 2024
Messages
12
Office Version
  1. 2013
Platform
  1. Windows
Hallo i am new and hope you can help.
I am trying to copy a range cells by search on sheet 2 with a inputbox then select the cells and copy them on sheet 1 by inputbox select cell/cells to copy to.
This works ok but i want to stay on sheet 1, now it going to sheet 2 and i have to go back to sheet 1 manually.
I use this code below can someone help.

VBA Code:
Sub Find_First()
Dim FindString As String
Dim rng As Range
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
    With Sheets("Sheet2").Range("A:M") 'searches all of column A to M
        Set rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not rng Is Nothing Then
            Application.Goto rng, False 'value found
        Else
            MsgBox "Nothing found" 'value not found
        End If
    End With
End If
ActiveCell.CurrentRegion.Select
   On Error Resume Next
    Set Ret = Application.InputBox(Prompt:="Please select a range where you want to paste", Type:=8)
    On Error GoTo 0
    If Not Ret Is Nothing Then
        Selection.Copy
        Ret.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    End If
  
End Sub
 
Last edited by a moderator:

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Hi and welcome

Try this:

VBA Code:
Sub Find_First()
  Dim FindString As String
  Dim rng As Range, ret As Range
  
  FindString = InputBox("Enter a Search value")
  If Trim(FindString) <> "" Then
    With Sheets("Sheet2").Range("A:M") 'searches all of column A to M
      Set rng = .Find(FindString, , LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
      If Not rng Is Nothing Then
        On Error Resume Next
        Set ret = Application.InputBox(Prompt:="Please select a range where you want to paste", Type:=8)
        On Error GoTo 0
        If Not ret Is Nothing Then
          rng.CurrentRegion.Copy ret
        End If
      Else
        MsgBox "Nothing found" 'value not found
      End If
    End With
  End If
  
End Sub

🤗
 
Upvote 0
Hallo DanteAmor, thanks for the help the code works it stays on cheet1 now.
But one problem that I now have is that it not copy the text and the make up but also the formula in a cell
It just must copy the make up of the cell and the text in to Sheet 1 not the formula then i get #VERW! when past it
 
Upvote 0
HI I found the solution.

VBA Code:
Sub Find_First()
  Dim FindString As String
  Dim rng As Range, ret As Range
 
  FindString = InputBox("Enter a Search value")
  If Trim(FindString) <> "" Then
    With Sheets("Sheet2").Range("A3:DM3") 'searches all of column A to M
      Set rng = .Find(FindString, , LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
      If Not rng Is Nothing Then
        On Error Resume Next
        Set ret = Application.InputBox(Prompt:="Please select a range where you want to paste", Type:=8)
        On Error GoTo 0
        If Not ret Is Nothing Then
          rng.CurrentRegion.Copy
          
          ret.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        
        ret.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        
        End If
      Else
        MsgBox "Nothing found" 'value not found
      End If
    End With
  End If
 
End Sub
 
Upvote 0
But one problem that I now have is that it not copy the text and the make up but also the formula in a cell

1726670285288.png


In your original code you are pasting everything, that's why I was also pasting everything.


I put my updated code
VBA Code:
Sub Find_First()
  Dim FindString As String
  Dim rng As Range, ret As Range
  
  FindString = InputBox("Enter a Search value")
  If Trim(FindString) <> "" Then
    With Sheets("Sheet2").Range("A3:DM3") 'searches all of column A to DM in row 3
      Set rng = .Find(FindString, , xlValues, xlWhole, xlByRows, xlNext, False)
      If Not rng Is Nothing Then
        On Error Resume Next
        Set ret = Application.InputBox(Prompt:="Please select a range where you want to paste", Type:=8)
        On Error GoTo 0
        If Not ret Is Nothing Then
          rng.CurrentRegion.Copy
          ret.PasteSpecial xlPasteValues
          ret.PasteSpecial xlPasteFormats
        End If
      Else
        MsgBox "Nothing found" 'value not found
      End If
    End With
  End If
  
End Sub

🤗
 
Upvote 0
Thanks , yes you are right I was testing on blank sheets did not have that problem, there where no formula.:)
Can you make the code so that it ask for how many copy to past in one input box.
only problem is that i get 3 popups then that's not so nice.
InputBox("Enter a Search value")
InputBox(Prompt:="Please select a range where you want to paste",
InputBox(Prompt:="How many copies",
Is it possible to make this one box?
 
Upvote 0
Can you make the code so that it ask for how many copy to past in one input box.
What do you mean by that?
For example, if I want it 3 times.
Do you want to copy once and paste to cell 1, then paste to cell 2 and paste to cell 3?
You can explain it.

Instead of several inputboxes, you could create a userform.
 
Upvote 0
No the Code makes a selection of 5 cells on Sheet2 copy this to a selected cell on sheet1 also the 5 cells
I like that it ask how many times it has to past the cells (5) it have to be past in the same colomn under the first 5 cells.

select cells (5) sheet2 (then how many copies) then Past to sheet1, when input is 3 times it copies 15 cells in the same colomn.
when 2 times it copies 10 same colomn
 
Upvote 0
I like that it ask how many times it has to past the cells (5) it have to be past in the same colomn under the first 5 cells.

Try:

VBA Code:
Sub Find_First()
  Dim FindString As String
  Dim rng As Range, ret As Range
  Dim nTime As Variant
  Dim i As Long
  
  FindString = InputBox("Enter a Search value")
  If Trim(FindString) <> "" Then
    With Sheets("Sheet2").Range("A3:DM3") 'searches all of column A to DM in row 3
      Set rng = .Find(FindString, , xlValues, xlWhole, xlByRows, xlNext, False)
    End With
    
    If Not rng Is Nothing Then
      On Error Resume Next
      Set ret = Application.InputBox(Prompt:="Please select a range where you want to paste", Type:=8)
      On Error GoTo 0
      If Not ret Is Nothing Then
      
        nTime = Application.InputBox("how many copy to past", Type:=1)
        
        If nTime = False Then Exit Sub
      
        rng.CurrentRegion.Copy
        For i = 1 To nTime
          ret.PasteSpecial xlPasteValues
          ret.PasteSpecial xlPasteFormats
          Set ret = Cells(Rows.Count, ret.Column).End(3)(2)
        Next
        
      End If
    Else
      MsgBox "Nothing found" 'value not found
    End If
  End If
  
End Sub

😅
 
Upvote 0
Yes exactly what i mean Perfect.
thank You
I will try to make a Userform next and get the code in there. I Hope
 
Upvote 0

Forum statistics

Threads
1,224,596
Messages
6,179,804
Members
452,943
Latest member
Newbie4296

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
Back
Top