Problema con código de copia de datos de Formulario a Base de Datos
He preparado un Formulario + Base de Datos para clientes y me ha surgido un problema a la hora de copiarlos del formulario a la base de datos según mi intención sería a partir de la fila 15, copiar los datos y que al volver a pasar datos nuevos se desplazase 6 filas hacía abajo (De ser posible, ¿habría alguna forma para que la macro en función de los productos contratados ajustara el número de filas a añadir?). Una vez copiados los datos se borrarían las celdas habilitadas del formulario y el código de cliente sumaría uno respecto al anterior. El problema es que ahora me pasa los datos en la fila 7. ¿Qué error hay en el código de la macro?.
Option Explicit
Sub Captura_Datos()
Application.ScreenUpdating = False
'
ActiveSheet.Unprotect
'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 = "Atención al Cliente"
'
Continuar = MsgBox("Dar de alta los datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("BDG").Cells(15, 15).CurrentRegion
Sheets("BDG").Select
Rows("15:20").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
NewRow = TransRowRng.Rows.Count + 6
With ThisWorkbook.Worksheets("BDG")
.Cells(NewRow, 1).Value = ThisWorkbook. Sheets(1). Range("C6") 'COD CLIENTE
.Cells(NewRow, 2).Value = ThisWorkbook. Sheets(1). Range("C9") 'NOMBRE
.Cells(NewRow, 3).Value = ThisWorkbook. Sheets(1). Range("C12") 'APELLIDOS
.Cells(NewRow, 4).Value = ThisWorkbook. Sheets(1). Range("C15") 'DNI
.Cells(NewRow, 5).Value = ThisWorkbook. Sheets(1). Range("I9") 'TELÉFONO FIJO
.Cells(NewRow, 6).Value = ThisWorkbook. Sheets(1). Range("I12") 'MÓVIL
.Cells(NewRow, 7).Value = ThisWorkbook. Sheets(1). Range("I15") 'EMAIL
.Cells(NewRow, 8).Value = Date
.Cells(NewRow, 9).Value = ThisWorkbook. Sheets(1). Range("C18") 'PRODUCTO 1
.Cells(NewRow, 10).Value = ThisWorkbook. Sheets(1). Range("F18") 'MOD. P1
.Cells(NewRow, 11).Value = ThisWorkbook. Sheets(1). Range("I18") 'VENCIMIENTO P1
.Cells(NewRow + 1, 9).Value = ThisWorkbook.Sheets(1).Range("C19") 'PRODUCTO 2
.Cells(NewRow + 1, 10).Value = ThisWorkbook.Sheets(1).Range("F19") 'MOD. P2
.Cells(NewRow + 1, 11).Value = ThisWorkbook.Sheets(1).Range("I19") 'VENCIMIENTO P2
.Cells(NewRow + 2, 9).Value = ThisWorkbook.Sheets(1).Range("C20") 'PRODUCTO 3
.Cells(NewRow + 2, 10).Value = ThisWorkbook.Sheets(1).Range("F20") 'MOD. P3
.Cells(NewRow + 2, 11).Value = ThisWorkbook.Sheets(1).Range("I20") 'VENCIMIENTO P3
.Cells(NewRow + 3, 9).Value = ThisWorkbook.Sheets(1).Range("C21") 'PRODUCTO 4
.Cells(NewRow + 3, 10).Value = ThisWorkbook.Sheets(1).Range("F21") 'MOD. P4
.Cells(NewRow + 3, 11).Value = ThisWorkbook.Sheets(1).Range("I21") 'VENCIMIENTO P4
.Cells(NewRow + 4, 9).Value = ThisWorkbook.Sheets(1).Range("C22") 'PRODUCTO 5
.Cells(NewRow + 4, 10).Value = ThisWorkbook.Sheets(1).Range("F22") 'MOD. P5
.Cells(NewRow + 4, 11).Value = ThisWorkbook.Sheets(1).Range("I22") 'VENCIMIENTO P5
.Cells(NewRow + 5, 9).Value = ThisWorkbook.Sheets(1).Range("C23") 'PRODUCTO 2
.Cells(NewRow + 5, 10).Value = ThisWorkbook.Sheets(1).Range("F23") 'MOD. P2
.Cells(NewRow + 5, 11).Value = ThisWorkbook.Sheets(1).Range("I23") 'VENCIMIENTO P2
End With
'
MsgBox "Alta exitosa.", vbInformation, strTitulo
Limpiar = MsgBox("Deseas limpiar los campos de la captura?", vbYesNo, strTitulo)
If Limpiar = vbYes Then
With ActiveWorkbook.Sheets(1)
.Range("C9").ClearContents
.Range("C12").ClearContents
.Range("C15").ClearContents
.Range("I9").ClearContents
.Range("I12").ClearContents
.Range("I15").ClearContents
.Range("C18").ClearContents
.Range("C19").ClearContents
.Range("C20").ClearContents
.Range("C21").ClearContents
.Range("C22").ClearContents
.Range("C23").ClearContents
'ClearContents no funciona en celda combinada...
End With
Else
End If
Sheets("CAPTURA").Select
Range("C9").Select
[C6] = [C6] + 1
ActiveSheet.Protect
'
End Sub
