Ayuda Dante Amor! Puedo cambiar esta macro?
Hola Dante Amor!
Quisiera saber si puedo modificar esta macro para lo siguiente:
Tengo un formulario en el que cada vez que ejecuto la macro se captura en otra pestaña los datos que necesito, sin embargo, se van agregando por fila.
Ya intenté modificarla porque me sería más útil que se vayan agregando por columna, pero no logro hacerlo. ¿Es posible modificarla? O ¿Cuál sería tu sugerencia para hacer esto?
Debo comentarte que los datos a capturar son de un rango de 3 columnas con 300 filas, por lo que se irían agregando esas 3 columnas en cada captura.
Agradezco tu ayuda nuevamente.
Saludos!!!
Option Explicit
Sub Reunión()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Integer
Dim Limpiar As String
'
strTitulo = "Confirmación"
'
Continuar = MsgBox("¿Registrar datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("PRUEBA").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("PRUEBA")
.Cells(NewRow, 1).Value = ThisWorkbook.Sheets("Alta").Range("B2")
.Cells(NewRow, 2).Value = ThisWorkbook.Sheets("Alta").Range("B3")
.Cells(NewRow, 3).Value = ThisWorkbook.Sheets("Alta").Range("B4")
.Cells(NewRow, 4).Value = ThisWorkbook.Sheets("Alta").Range("B5")
.Cells(NewRow, 5).Value = ThisWorkbook.Sheets("Alta").Range("B6")
.Cells(NewRow, 6).Value = ThisWorkbook.Sheets("Alta").Range("C2")
.Cells(NewRow, 7).Value = ThisWorkbook.Sheets("Alta").Range("C3")
.Cells(NewRow, 8).Value = ThisWorkbook.Sheets("Alta").Range("C4")
.Cells(NewRow, 9).Value = ThisWorkbook.Sheets("Alta").Range("C5")
.Cells(NewRow, 10).Value = ThisWorkbook.Sheets("Alta").Range("C6")
End With
'
MsgBox "Registro finalizado", vbInformation, strTitulo
Limpiar = MsgBox("Limpiar registros", vbYesNo, strTitulo)
If Limpiar = vbYes Then
With ActiveWorkbook.Sheets("Alta")
.Range("B2:C6").ClearContents
End With
Else
End If
'
End Sub
1 Respuesta
Puedes enviarme un archivo con 3 hojas con lo siguiente:
En la hoja "Alta1" u hoja de captura, me pones un ejemplo de lo que capturas.
En la hoja "PRUEBA" u hoja donde registras, me pones los mismos datos del la hoja "Alta1" acomodados de la forma en que los necesitas y me los pintas de amarillo.
En otra hoja "Alta2" me pones otro ejemplo de lo que captruas.
En la hoja "PRUEBA", me pones los mismos datos de la hoja "Alta2", acomodados de la forma en que los necesitas y me los pintas de verde.
De esa forma puedo identificar qué necesitas y cómo debe funciona la macro.
Hola!
Acabo de enviarte el archivo que me solicitaste. Gracias por la ayuda. Saludos!!!
La macro para agregar por columna
Sub Registrar()
'Por.Dante Amor
If MsgBox("Registrar datos?", vbYesNo + vbQuestion, "Confirmación") = vbNo Then Exit Sub
'
If [B3] = "" Then MsgBox "Falta la fecha": Exit Sub
'
Set h1 = Sheets("Alta")
Set h2 = Sheets("PRUEBA")
uc = h2.Cells(1, Columns.Count).End(xlToLeft).Column + 1
h2.Cells(1, uc) = h1.[B3]
h2.Cells(2, uc) = h1.[B6]
h2.Cells(3, uc) = h1.[B7]
h2.Cells(4, uc) = h1.[B8]
h2.Cells(5, uc) = h1.[B9]
h2.Cells(6, uc) = h1.[B10]
h2.Cells(7, uc) = h1.[C6]
h2.Cells(8, uc) = h1.[C7]
h2.Cells(9, uc) = h1.[C8]
h2.Cells(10, uc) = h1.[C9]
h2.Cells(11, uc) = h1.[C10]
'
If MsgBox("Registro finalizado" & vbCr & vbCr & _
"Limpiar registros", vbQuestion + vbYesNo, "Confirmación") = vbYes Then
h1.Range("B6:C10").ClearContents
End If
End Sub
