Copiar fila por fila con botón excel vba
Bueno quiero realizar una macro que haga lo siguiente:
Tengo 2 hojas, en la primera hoja tengo estos datos:
y en la hoja 2 tengo este formulario:
Lo que deseo, es que la macro se ubique en la fila 5 de la hoja1 y me copie los datos que te pide el formulario de la hoja 2. Y cada vez que le doy al botón IMPRIMIR, baje a la siguiente fila y vuelva a copiar los datos de esa fila y así sucesivamente.
Haber si me ayudan amigos.
1 respuesta
Puedes poner cada celda de la hoja1 va en cuál celda de la hoja2,
Por ejemplo, la celda B5 de la hoja 1, va en la celda E16 de la hoja2
Y así para cada celda.
La macro funcionaría así, si en la hoja1 no tienes seleccionada ninguna celda de la columna B, entonces empezaría en B5, vuelves a presionar "imprimir" y entonces pondría los datos de B6, y así sucesivamente hasta llegar al último dato de la columna B de la hoja1.
Entonces, suponiendo que te quedaste en B6, pero, si vas a la hoja1 y seleccionas B70 y presionas"imprimir", la macro no va a seleccionar B7, sino que como moviste el cursor de la hoja1, entonces la macro seleccionaría B71.
De esa forma, también te serviría, si quisieras imprimir la B18, solamente tendrías que seleccionar en la hoja B17, presionar el botón y automáticamente te pondría los datos de la B18.
Estimado dante,. no veo la macro.
lo que pides es lo siguiente: suponiendo que estamos en la B5: el rango C5 (hoja1) en E15 (hoja2);
B5 en E16; H5 al E17; F5 a I9 y F5 aD13 (pero en letras)
No habías pedido la cantidad con letra, pero ahí va. Ejecuta la macro Llenar_Formato.
Pon todo el código en un módulo.
Sub Llenar_Formato()
'---
' Por.Dante Amor
'---
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1") 'hoja de datos
Set h2 = Sheets("Hoja2") 'hoja formulario
'
h1.Activate
Set celda = ActiveCell
If celda.Column = 2 And celda.Row > 4 Then
fila = celda.Row + 1
Else
fila = 5
End If
If Cells(fila, "B").Value = "" Then
fila = 5
End If
Cells(fila, "B").Select
'
h2.Select
h2.[E15] = h1.Cells(fila, "C")
h2.[E16] = h1.Cells(fila, "B")
h2.[E17] = h1.Cells(fila, "H")
h2.[I9] = h1.Cells(fila, "F")
If IsNumeric(h1.Cells(fila, "F")) Then
h2.[D13] = CONVERTIRNUM(h1.Cells(fila, "F"))
End If
Application.ScreenUpdating = True
End Sub
'
Function CONVERTIRNUM(Numero As Double, Optional CentimosEnLetra As Boolean) As String
Dim Moneda As String
Dim Monedas As String
Dim Centimo As String
Dim Centimos As String
Dim Preposicion As String
Dim NumCentimos As Double
Dim Letra As String
Const Maximo = 1999999999999.99
'************************************************************
' Parámetros
'************************************************************
Moneda = "Peso" 'Nombre de Moneda (Singular)
Monedas = "Pesos" 'Nombre de Moneda (Plural)
Centimo = "Centavo" 'Nombre de Céntimos (Singular)
Centimos = "Centavos" 'Nombre de Céntimos (Plural)
Preposicion = "Con" 'Preposición entre Moneda y Céntimos
'************************************************************
'Validar que el Numero está dentro de los límites
If (Numero >= 0) And (Numero <= Maximo) Then
Letra = NUMERORECURSIVO((Fix(Numero))) 'Convertir el Numero en letras
'Si Numero = 1 agregar leyenda Moneda (Singular)
If (Numero = 1) Then
Letra = Letra & " " '& Moneda
'De lo contrario agregar leyenda Monedas (Plural)
Else
Letra = Letra & " " '& Monedas
End If
NumCentimos = Round((Numero - Fix(Numero)) * 100) 'Obtener los centimos del Numero
'NumCentimos = Round((Numero - Fix(Numero)) * 10) 'Obtener los centimos del Numero
'Si NumCentimos es mayor a cero inicar la conversión
If NumCentimos >= 0 Then
'Si el parámetro CentimosEnLetra es VERDADERO obtener letras para los céntimos
If CentimosEnLetra Then
Letra = Letra & " " & Preposicion & " " & NUMERORECURSIVO(Fix(NumCentimos)) 'Convertir los céntimos en letra
'Si NumCentimos = 1 agregar leyenda Centimos (Singular)
If (NumCentimos = 1) Then
Letra = Letra & " " '& Centimo
'De lo contrario agregar leyenda Centimos (Plural)
Else
Letra = Letra & " " '& Centimos
End If
'De lo contrario mostrar los céntimos como número
Else
If NumCentimos < 10 Then
Letra = Letra & " 0" & NumCentimos & "/100"
Else
Letra = Letra & " " & NumCentimos & "/100"
End If
End If
End If
'Regresar el resultado final de la conversión
CONVERTIRNUM = Letra '& " M.N."
Else
'Si el Numero no está dentro de los límites, entivar un mensaje de error
CONVERTIRNUM = "ERROR: El número excede los límites."
End If
End Function
Function NUMERORECURSIVO(Numero As Long) As String
Dim Unidades, Decenas, Centenas
Dim Resultado As String
'**************************************************
' Nombre de los números
'**************************************************
Unidades = Array("", "Un", "Dos", "Tres", "Cuatro", "Cinco", "Seis", "Siete", "Ocho", "Nueve", "Diez", "Once", "Doce", "Trece", "Catorce", "Quince", "Dieciséis", "Diecisiete", "Dieciocho", "Diecinueve", "Veinte", "Veintiuno", "Veintidos", "Veintitres", "Veinticuatro", "Veinticinco", "Veintiseis", "Veintisiete", "Veintiocho", "Veintinueve")
Decenas = Array("", "Diez", "Veinte", "Treinta", "Cuarenta", "Cincuenta", "Sesenta", "Setenta", "Ochenta", "Noventa", "Cien")
Centenas = Array("", "Ciento", "Doscientos", "Trescientos", "Cuatrocientos", "Quinientos", "Seiscientos", "Setecientos", "Ochocientos", "Novecientos")
'**************************************************
Select Case Numero
Case 0
Resultado = "Cero"
Case 1 To 29
Resultado = Unidades(Numero)
Case 30 To 100
Resultado = Decenas(Numero \ 10) + IIf(Numero Mod 10 <> 0, " y " + NUMERORECURSIVO(Numero Mod 10), "")
Case 101 To 999
Resultado = Centenas(Numero \ 100) + IIf(Numero Mod 100 <> 0, " " + NUMERORECURSIVO(Numero Mod 100), "")
Case 1000 To 1999
Resultado = "Mil" + IIf(Numero Mod 1000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000), "")
Case 2000 To 999999
Resultado = NUMERORECURSIVO(Numero \ 1000) + " Mil" + IIf(Numero Mod 1000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000), "")
Case 1000000 To 1999999
Resultado = "Un Millón" + IIf(Numero Mod 1000000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000000), "")
Case 2000000 To 1999999999
Resultado = NUMERORECURSIVO(Numero \ 1000000) + " Millones" + IIf(Numero Mod 1000000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000000), "")
End Select
NUMERORECURSIVO = Resultado
End Function
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Interesante! - Adriel Ortiz Mangia