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

1 Respuesta

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