Macro que no funciona.

Hola experto, tengo una macro larguísima que copia dos datos de una hoja ("SIMPLE MUST MOVE") a otra columna de la misma hoja y en otra hoja("REGISTRO"). Necesito que los datos en la hoja de registro aparezcan bordeados arriba y abajo. No se programar, lo que hago es copiar programas que vosotros publicáis y los adapto como puedo a mis necesidades, pero esta vez no doy con la clave. Con lo que he añadido si que bordea los datos en la hoja de registro pero en la hoja ("SIMPLE MUST MOVE") aparecen transformados en cifras. Esta es la macro, sólo copio un trozo que si no es demasiado larga y no me deja enviárosla ( en negrita lo que he añadido, sin ello funciona perfectamente):
Public snCambioE4 As Boolean
Public ORIGEN1 As String
Public ORIGEN3 As String
Sub CrearaRegistro3()
ORIGEN1 = "REGISTRO"
ORIGEN3 = "SIMPLE MUST MOVE"
    copiaValorB5enHoja2a Cells(5, 4)
    copiaValorB6enHoja2a Cells(5, 8)
    copiaValorB5enHoja1a Cells(5, 4)
    copiaValorB6enHoja1a Cells(5, 8)
    Sheets(ORIGEN3).Select
    Cells(5, 4).Select
End Sub
Private Sub copiaValorB5enHoja2a(ByVal valorB5)
    Dim nLin As Long
    If IsNull(valorB5) Or valorB5 = "" Then Exit Sub
       ' Buscaremos de forma rápida la última línea grabada
    ' Primero de 1000 en 1000 hasta que no haya nada
    nLin = 2
    Do While Sheets(ORIGEN1).Cells(nLin, 2) <> ""
        nLin = nLin + 1000
    Loop
    ' Volvemos hacia atras de 25 en 25 hasta que haya una ocupada
    Do While Sheets(ORIGEN1).Cells(nLin, 2) = ""
        If nLin > 25 Then nLin = nLin - 25 Else Exit Do
    Loop
    ' Y buscamos de 1 en 1 hacia delante hasta que haya una libre
    Do While Sheets(ORIGEN1).Cells(nLin, 2) <> ""
        nLin = nLin + 1
    Loop
   With Worksheets("REGISTRO").Activate
   Range(Cells(nLin, 2), Cells(nLin, 8)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
    Sheets(ORIGEN1).Cells(nLin, 2) = valorB5
    Sheets(ORIGEN1).Cells(nLin, 4) = Time()
    Sheets(ORIGEN1).Cells(nLin, 7) = "TX 5/10"
End Sub
Private Sub copiaValorB6enHoja2a(ByVal valorB5)
    Dim nLin As Long   
    If IsNull(valorB5) Or valorB5 = "" Then Exit Sub  
    nLin = 2
    Do While Sheets(ORIGEN1).Cells(nLin, 3) <> ""
        nLin = nLin + 1000
    Loop
  (corto un trozo,,,es lo mismo para la otra celda,,,,,,,,)
Private Sub copiaValorB5enHoja1a(ByVal valorB5)
    Dim nLin As Long
    If IsNull(valorB5) Or valorB5 = "" Then Exit Sub
    ' Buscaremos de forma rápida la última línea grabada
    ' Primero de 1000 en 1000 hasta que no haya nada
    nLin = 3
    Do While Sheets(ORIGEN3).Cells(nLin, 11) <> ""
        nLin = nLin + 1000
    Loop
( Y aquí también corto que es muy largo, pero no he modificado nada, es lo mismo pero en (ORIGEN3), y en las celdas (nLin, 11) y (nLin, 12)
  End Sub
{"Lat":38.8225909761771,"Lng":-4.921875}

1 respuesta

Respuesta
1
Ya que no sabes programar mucho, pero más o menos copias y pegas código y lo modificas lo que puedes hacer es lo siguiente:
Graba una macro: Herramientas -> Macro -> Grabar nueva macro...
Ahora pincha en una celda cualquiera y pon los bordes de la misma manera que quieras que aparezcan en tu tabla copiada. Tendrás en una módulo nuevo un código como este:
Sub Macro1()
'
' Macro1 Macro
' Macro grabada el 20/05/2011 por wynd
'
'
    Range("H11").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub
La línea que he puesto en negrita debes cambiarla por Sheets(ORIGEN1). Cells(nLin, 2) y situar todo este código nuevo (sin sub y end sub) debajo de la línea Sheets(ORIGEN1). Cells(nLin, 2) = valorB5, o la que te interese poner borde.
Si no eres capaz de solucionarlo puedes mandarme el excel por mail y lo vemos mejor.
[email protected]

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas