Valor de copia de Excel VBA a nuevo

Soy nuevo en VBA y macros. He estado tropezando bastante decentemente, pero me he encontrado con este problema y no estoy seguro de cómo modificar el código.

Necesito que el usuario pueda ingresar un valor (número) para buscar en toda la hoja de trabajo, luego, una vez que se encuentre, copie y pegue en la siguiente celda vacía en la columna B en otra hoja en la misma hoja de trabajo.

Se pone cada vez menos donde quiero que esté.

Cualquier ayuda sería apreciada.

Sub Reference_Lookup_Paste()
' Written by Barrie Davidson
Dim datatoFind
Dim sheetCount As Integer
Dim counter As Integer
Dim currentSheet As Integer

Application.ScreenUpdating = False

On Error Resume Next
currentSheet = ActiveSheet.Index
datatoFind = InputBox("Please enter the Reference Number.")
If datatoFind = "" Then Exit Sub
sheetCount = ActiveWorkbook.Sheets.count
If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)
For counter = 1 To sheetCount
Sheets(counter).Activate
Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If ActiveCell.Value = datatoFind Then Call Reference_Move
On Error Resume Next

Next counter
If ActiveCell.Value <> datatoFind Then
MsgBox ("Value not found")
Sheets(currentSheet).Activate
End If
End Sub

Sub Reference_Move()
Selection.Copy
Sheets("Service-Warranty").Select

Dim r1 As Range, r2 As Range
Set r1 = Intersect(Range("B:B"), Cells.SpecialCells(xlCellTypeBlanks))
Set r2 = Cells(Rows.count, "B").End(xlUp).Offset(1, 0)
If r1 Is Nothing Then
    r2.Select
Else
    r1(1).Select
End If
ActiveSheet.Paste
End Sub

Aquí está la llamada si ActiveCell.Value = datatoFind

Sub Reference_Move()
Selection.Copy
Sheets("Service-Warranty").Select

Dim r1 As Range, r2 As Range
Set r1 = Intersect(Range("B:B"), Cells.SpecialCells(xlCellTypeBlanks))
Set r2 = Cells(Rows.count, "B").End(xlUp).Offset(1, 0)
If r1 Is Nothing Then
    r2.Select
Else
    r1(1).Select
End If
ActiveSheet.Paste
End Sub

Actualización: ahora encontrará el valor y lo pegará en la columna adecuada, pero pegará 4 celdas en lugar de solo una, y cuando no se encuentren los datos, pegará lo que esté en el portapapeles.

Sub Reference_Lookup_Paste()
' Written by Barrie Davidson
Dim datatoFind
Dim sheetCount As Integer
Dim counter As Integer
Dim currentSheet As Integer

Application.ScreenUpdating = False

On Error Resume Next
currentSheet = ActiveSheet.Index
datatoFind = InputBox("Please enter the Reference Number.")
If datatoFind = "" Then Exit Sub
sheetCount = ActiveWorkbook.Sheets.count
If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)
For counter = 1 To sheetCount
Sheets(counter).Activate
Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If ActiveCell.Value = datatoFind Then Selection.Copy

Sheets("Service-Warranty").Select

Range("B1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste

Next counter
If ActiveCell.Value <> datatoFind Then
MsgBox ("Value not found")
Sheets(currentSheet).Activate
End If
End Sub

Debe evitar usarlo .Selectcomo método de referencia de celdas, rangos de celdas e incluso hojas de trabajo. Cada uno puede ser referenciado directamente a su manera. Consulte Cómo evitar el uso de macros Seleccionar en Excel VBA de ese otro sitio.

Aquí hay un código que utiliza referencias directas mientras se logran los objetivos establecidos.

Sub Reference_Lookup_Paste()
    Dim sMsg As String, datatoFind As Variant
    Dim s As Long, rw As Long, cl As Long

    Application.ScreenUpdating = False

    datatoFind = InputBox("Please enter the Reference Number.")
    If datatoFind = "" Then Exit Sub
    If IsNumeric(datatoFind) Then datatoFind = CDbl(datatoFind)
    sMsg = datatoFind & " found on:" & Chr(10)
    For s = 1 To ActiveWorkbook.Sheets.Count
        If Not Sheets(s).Name = "Service-Warranty" Then 'assumed that you want to skip this one
            With Sheets(s).Cells(1, 1).CurrentRegion
                If CBool(Application.CountIf(.Cells, datatoFind)) Then
                    sMsg = sMsg & .Parent.Name & Chr(10)
                    Sheets("Service-Warranty").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) = datatoFind
                    Exit For
                End If
            End With
        End If
    Next s

    If Len(sMsg) > (InStr(1, sMsg, datatoFind & " found on:" & Chr(10), vbTextCompare) + 1) Then
        MsgBox sMsg
    Else
        MsgBox datatoFind & "Value not found."
    End If

    Application.ScreenUpdating = True
End Sub

He usado VBA Application.Countifpara ver todas las celdas pobladas de cada hoja de trabajo .CurrentRegiona la vez. La hoja de trabajo .Cells(1, 1).CurrentRegiones la isla ininterrumpida de datos que comienza en A1 y continúa tanto hacia la derecha como hacia abajo hasta que encuentra una fila o columna completamente en blanco. Puede demostrar esto seleccionando A1 y tocando Ctrl+ A.