Modificar código, para introducir bucles para que no tenga que repetir la misma instrucción varias veces.

Alguien me podría ayudar con un código para introducirle bucles y no repetir la misma acción varias veces. Anexo código.

Option Explicit
Sub Capturar_Folio_maritimo()
'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 = "Folios Maritimos"
'
Continuar = MsgBox("¿Desea guardar este Folio Maritimo?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("Folios Maritimos").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("Folios Maritimos")
. Cells(NewRow, 1).Value = UCase(ThisWorkbook. Sheets(2). Range("B2"))
. Cells(NewRow, 2).Value = UCase(ThisWorkbook. Sheets(2). Range("B3"))
. Cells(NewRow, 3).Value = UCase(ThisWorkbook. Sheets(2). Range("B4"))
. Cells(NewRow, 4).Value = UCase(ThisWorkbook. Sheets(2). Range("B5"))
. Cells(NewRow, 5).Value = UCase(ThisWorkbook. Sheets(2). Range("B6"))
. Cells(NewRow, 6).Value = UCase(ThisWorkbook. Sheets(2). Range("B7"))
. Cells(NewRow, 7).Value = UCase(ThisWorkbook. Sheets(2). Range("B8"))
. Cells(NewRow, 8).Value = UCase(ThisWorkbook. Sheets(2). Range("B9"))
. Cells(NewRow, 9).Value = UCase(ThisWorkbook. Sheets(2). Range("B10"))
. Cells(NewRow, 10).Value = UCase(ThisWorkbook. Sheets(2). Range("B11"))
. Cells(NewRow, 11).Value = UCase(ThisWorkbook. Sheets(2). Range("B12"))
. Cells(NewRow, 12).Value = UCase(ThisWorkbook. Sheets(2). Range("B13"))
. Cells(NewRow, 13).Value = UCase(ThisWorkbook. Sheets(2). Range("B14"))
. Cells(NewRow, 14).Value = UCase(ThisWorkbook. Sheets(2). Range("B15"))
. Cells(NewRow, 15).Value = UCase(ThisWorkbook. Sheets(2). Range("B16"))
. Cells(NewRow, 16).Value = UCase(ThisWorkbook. Sheets(2). Range("B17"))
End With
'
MsgBox "Guardado con Exito", vbInformation, strTitulo
Limpiar = MsgBox("¿Deseas limpiar los campos de la captura?", vbYesNo, strTitulo)
If Limpiar = vbYes Then
With ActiveWorkbook.Sheets(2)
. Range("B2"). ClearContents
. Range("B3"). ClearContents
. Range("B4"). ClearContents
. Range("B5"). ClearContents
. Range("B6"). ClearContents
. Range("B7"). ClearContents
. Range("B8"). ClearContents
. Range("B9"). ClearContents
. Range("B10"). ClearContents
. Range("B11"). ClearContents
. Range("B12"). ClearContents
. Range("B13"). ClearContents
. Range("B14"). ClearContents
. Range("B15"). ClearContents
. Range("B16"). ClearContents
. Range("B17"). ClearContents
End With
Else
End If
'
End Sub

Respuesta
1

Te agrego la modificación solicitada

Option Explicit
Sub Capturar_Folio_maritimo()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Long      'te cambié esto porque a medida que crezca el Integer no te va a servir
Dim Limpiar As String
Dim I as Integer
'
strTitulo = "Folios Maritimos"
'
Continuar = MsgBox("¿Desea guardar este Folio Maritimo?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("Folios Maritimos").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("Folios Maritimos")
For I = 1 To 16
.Cells(NewRow, I).Value = UCase(ThisWorkbook.Sheets(2).Cells(I+1,"B"))
End With
'
MsgBox "Guardado con Exito", vbInformation, strTitulo
Limpiar = MsgBox("¿Deseas limpiar los campos de la captura?", vbYesNo, strTitulo)
If Limpiar = vbYes Then
  ActiveWorkbook.Sheets(2).Range("B2:B17").ClearContents
End If
'
End Sub

Dante me manda un error de compilacion End With sin With

Soy Gustavo pero no hay problemas ;)

¿Reemplazaste todo el código? Porque mirá que vos estabas usando 2 With y yo eliminé el segundo de ellos... ¿en qué línea se queda posicionado el cursor cuando te da el error?

disculpa Gustavo.  me sobrea en azul el End With y me marca de amarillo 

Sub Capturar_Folio_maritimo()

Por las dudas te lo paso nuevamente, eliminando todos los With, ya que solo quedan para una línea y termina siendo más confuso, el nuevo código es

Option Explicit
Sub Capturar_Folio_maritimo()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Long      'te cambié esto porque a medida que crezca el Integer no te va a servir
Dim Limpiar As String
Dim I as Integer
strTitulo = "Folios Maritimos"
Continuar = MsgBox("¿Desea guardar este Folio Maritimo?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
Set TransRowRng = ThisWorkbook.Worksheets("Folios Maritimos").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
For I = 1 To 16
 ThisWorkbook.Worksheets("Folios Maritimos").Cells(NewRow, I).Value = UCase(ThisWorkbook.Sheets(2).Cells(I+1,"B"))
Next I
MsgBox "Guardado con Exito", vbInformation, strTitulo
Limpiar = MsgBox("¿Deseas limpiar los campos de la captura?", vbYesNo, strTitulo)
If Limpiar = vbYes Then
  ActiveWorkbook.Sheets(2).Range("B2:B17").ClearContents
End If
End Sub

Ahí ví el problema...en realidad se debía a que no estaba el Next (que cierra el For)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Como utilizar dos macros que empiezan con Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Quiero integrar dos macros que realizan una funcion cada una pero el asunto es que las dos deben funcionar el la misma hoja y empiezan con Private Sub Worksheet_SelectionChange(ByVal Target As Range) y a la hora de ejecutar las dos marcan error. ¿Qué...
2 respuestas

Rutina para buscar y reemplazar un texto concreto en varios documentos de Excel

Quisiera una rutina en Excel que hiciera lo siguiente: - Buscar y reemplazar texto dentro de páginas de excel, pero que la búsqueda sea en todos los archivos de excel que haya en un directorio indicado previamente. Creo que me he explicado más o...
2 respuestas

Pegar rango de excel en el cuerpo de una tarea

Quiero saber si es posible, usando vba se pueda pegar un rango con formatos en el cuerpo de una tarea de outlook. Estoy usando este código pero el rango lo pega en el campo del "asunto", espero puedas apoyarme con la solución. Saludos y de antemano...
1 respuesta

Ejecutar macro según el valor de la celda

Que tal necesito de su valiosa ayuda tengo que ejecutar una macro en automático esto depende del valor de la celda. Estoy utilizando la siguiente macro: Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$S$1" And...
1 respuesta

Macro borrar datos de hoja sin borrar formato

Tengo una macro con la que me ayudaron, trabaja muy bien la cual busca datos en un libro y los anota en una hoja llamada buscador, pero a esta hoja no puedo darle formato ya que se elimina al usarlo, es decir por ejemplo si le pongo un fondo a la...
1 respuesta

¿Cómo agregar un botón de comando "ACEPTAR" en excel que sustituya la tecla enter?

Que tengo, ¿Tengo una hoja de excel con un botón para limpiar contenido de las celdas pero quiero agregar otro botón de aceptar para que cuando yo escriba en una celda por ejemplo en D1 en vez de darle enter le de aceptar con el botón? Extiendo más...
1 respuesta

Actualizar datos en base de datos

¿Cómo agrego la opción de que antes de realizar una búsqueda nueva, o bien agregando un botón nuevo, actualice cualquier dato que se modifique, directamente en la base? En lectura simple sería: Hoja Búsqueda: Si se modifica cualquier dato, en rango...
1 respuesta

Hacer una búsqueda en una hoja especifica de un libro excel

Quisiera saber como puedo modificar parte de una macro para que realice la búsqueda en una sola hoja por ejemplo hoja datos, y no en todo el libro. O bien ingresar la hoja a buscar mediante un inputBox. Sub ejemplo() Sheets("buscador").Select Dim...
1 respuesta

Crear Formulario Excel (ayuda a un principiante)

Gurús del excel, estoy trabajando en un formulario de ingreso de datos y mi intención es aprender todo sobre la herramientas de formularios. El objetivo del formulario es entregar un código al usuario que lo ejecute y almacenar en otra hoja los datos...
1 respuesta

Buenas tardes como están... Tengo una macro que compara diferencias entre 2 hojas

La macro compara las diferencias entre las 2 hojas y copia las diferencia en una tercera. Y trabaja bien con 30 o 40 lineas pero necesito que compare unas 900 o 1000 lineas, Otra cosa esta macro tiene una hoja ( hoja 1 como master) y importa datos de...
1 respuesta