Enviar valores de celdas diferentes a otro archivo

Te envío un código que, asociado a un botón que se llama 'btnCopiar', hace lo que entiendo que quieres.
Tienes que copiarlo en el código de la página donde pongas el botón. Tienes que poner el nombre del fichero que tienes en la red, el nombre de la página donde se guardan los datos y el número de líneas que tiene tu página (según la versión de Excel). En resumen, revisa las líneas de definición de constantes que tienes al principio.
Espero que te funcione.
Un saludo
Option Explicit
Const nomLibroEnDiscoRed = "nombre del fichero excel en el disco de red"
Const nomHojaDestinoEnDiscoRed = "hoja1"
Const maxLin = 65536 ' El último número de linea de nuestra hoja (varía según la versión de Excel)
Private Sub btnCopiar_Click()
    Dim wbRed As Workbook
    Dim shRed As Worksheet
    Dim miSh As Worksheet
    Dim nLin As Long
    Dim resp As Integer
    Dim sErr As String
    Set miSh = ThisWorkbook.ActiveSheet
    ' Comprobamos si existe
    If Not existeLibroRed() Then
        MsgBox "ERROR: No existe el libro de red '" & nomLibroEnDiscoRed & "'. Proceso terminado."
        Exit Sub
    End If
    ' Abrimos el libro
    Do  ' Si hay error repetiremos el intento
        On Error Resume Next
        Set wbRed = Application.Workbooks.Open(nomLibroEnDiscoRed, False, False)
        If Err <> 0 Then sErr = Error$ Else sErr = ""
        On Error GoTo 0
        If sErr <> "" Then  ' Hemos tenido un error. Lo contamos y vemos qué hacer
            resp = MsgBox("Se ha producido un error al intentar abrir el libro " & _
                           "'" & nomLibroEnDiscoRed & "'. El mensaje es:" & _
                           vbCrLf & vbCrLf & sErr & vbCrLf & vbCrLf & _
                           "¿Desea que se intente abrir de nuevo?", vbExclamation + vbYesNo)
            If resp = vbNo Then ' No quiere intentarlo de nuevo
                MsgBox "Proceso cancelado"
                Exit Sub
            End If
        End If
    Loop Until sErr = ""    ' Repetimos hasta que no haya errores
    ' Asignamos la hoja y, si no existe, damos el error correspondiente
    If Not existeHojaEnLibroRed(wbRed, shRed) Then
        MsgBox "ERROR: No se encuentra la hoja '" & nomHojaDestinoEnDiscoRed & "' " & _
               "en el libro '" & nomLibroEnDiscoRed & "'." & vbCrLf & vbCrLf & _
               "Cree la hoja necesaria y vuelva a ejecutar este proceso"
        wbRed.Close False
        Exit Sub
    End If
    nLin = buscaPrimeraLineaEnBlanco(shRed)
    ' Copiamos los datos de nuestra hoja en la hoja de red, en la línea que acabamos
' de calcular.
    shRed.Cells(nLin, 1) = miSh.Cells(5, 2) ' De B5 a la Axxx
    shRed.Cells(nLin, 2) = miSh.Cells(8, 2) ' De B8 a la Bxxx
    shRed.Cells(nLin, 3) = miSh.Cells(12, 2) ' De B12 a la Cxxx
    shRed.Cells(nLin, 4) = miSh.Cells(15, 2) ' De B15 a la Dxxx
    shRed.Cells(nLin, 5) = Now() ' Ponemos la fecha en Exxx
    shRed.Cells(nLin, 5).NumberFormat = "dd/mm/yyyy hh:mm:ss"  ' Y le damos formato
    ' Cerramos y Guardamos el libro del disco de red
wbRed. Close True
    Set wbRed = Nothing
    Set shRed = Nothing
    Set miSh = Nothing
    MsgBox "Datos copiados al disco de red"
End Sub
Function existeLibroRed() As Boolean
    Dim aux As Variant
    ' Diremos que el libro existe cuando exista el fichero
    On Error Resume Next
    aux = FileLen(nomLibroEnDiscoRed)
    If Err <> 0 Then aux = -1
    On Error GoTo 0
    existeLibroRed = (aux >= 0)
End Function
Function existeHojaEnLibroRed(ByRef wb As Workbook, ByRef sh As Worksheet) As Boolean
    ' Si hay algún error al asignar la hoja... es que no existe
    On Error Resume Next
    Set sh = wb.Sheets(nomHojaDestinoEnDiscoRed)
    existeHojaEnLibroRed = (Err = 0)
    On Error GoTo 0
End Function
Function buscaPrimeraLineaEnBlanco(ByRef sh As Worksheet) As Long
    Dim i As Long
    ' Esta función devuelve el número de la primera línea que tiene
' la columna A en blanco
i = 1
    ' Para ir más rápidos, primero avanzaremos hacia delante de 1000 en 1000 líneas
' hasta encontrar una línea en blanco
    Do While sh.Cells(i, 1) <> ""
        If i = maxLin Then Exit Do  ' No puede ir más allá
        i = i + 1000
        If i > maxLin Then i = maxLin
    Loop
    ' Si no ha encontrado ninguna en blanco... adios
    If sh.Cells(i, 1) <> "" Then buscaPrimeraLineaEnBlanco = -1: Exit Function
    ' Ahora iremos hacia atrás de 50 en 50 hasta encontrar una línea escrita
    Do While sh.Cells(i, 1) = ""
        If i = 1 Then Exit Do   ' Ya está en la primera... y está en blanco
        i = i - 50
        If i <= 0 Then i = 1
    Loop
    ' Si la línea encontrada está en blanco es porque es la 1
    If sh.Cells(i, 1) = "" Then buscaPrimeraLineaEnBlanco = 1: Exit Function
    ' Para terminar avanzaremos hacia delante buscando la primera línea en blanco
    Do
        i = i + 1
    Loop Until sh.Cells(i, 1) = ""
    buscaPrimeraLineaEnBlanco = i
End Function