Error 1004 en tiempo de ejecución VBA Excel
Me estoy topando con el error 1004, el que adjunto en la imagen. Se cual es el error pero no se como solucionarlo para que se adapte a mi idea.
Lo hago mediante macros es copiar las celdas (C15:D40) de la hoja "Ventas" y pegarlas como valores en la celda A15 de la hoja "Comprobante 2" evitando los blancos (SkipBlanks). La hoja "Comprobante 2" tiene la característica de que posee todas las celdas bloqueadas excepto el rango (A15:B40).
Ahora bien, tengo una macro que busca productos de un listado, en donde elijo un producto y lo inserta en las celdas sin valores del rango (A15:B40) de la hoja "Comprobante 2". Entonces el problema es que la macro que trata de insertar un producto censa que están todas las celdas del rango con valores.
Para que se comprenda mejor, les dejo el código de la macro:
Dim n As Integer
Dim Z As Range
n = Application.WorksheetFunction.CountA(ActiveSheet.Range("A15:A40"))
If n = 26 Then
MsgBox "Todas las celdas están llenas para poder ingresar un nuevo código", vbInformation + vbOKOnly, "Celdas llenas"
'End
End If
If ActiveSheet.Range("A15").value = "" Then
ActiveSheet.Range("A15").value = MyVal
ActiveSheet.Range("A15").Offset(0, 1) = TextBox1.value
ingrese_cantidad.Hide
Else
Set Z = ActiveSheet.Range("A14").End(xlDown).Offset(1, 0)
ActiveSheet.Range("A14").End(xlDown).Offset(1, 0).value = MyVal
Z.Offset(0, 1) = TextBox1.value
ingrese_cantidad.Hide
End If
Es como que las celdas vacías copiadas me las pegaría como " ", por lo tanto la macro quiere ir a la celda A41 la cual esta bloqueada.
Para pegar las celdas copiadas uso esta linea:
Range("A15").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Ho la Lucas, bienvenido al foro.
Visita:
Me gustaría ayudarte pero no estás poniendo toda la información relevante:
1. Debes poner toda la macro.
2. Identificar en cuál línea tienes el problema
3. En tu macro veo que pasas los datos myval y el textbox a la hoja, pero no veo ni el copy ni el paste.
O comparte tu archivo en google drive para revisarlo. Después de subir el archivo a google drive comparte el archivo, copias el enlace y lo pegas aquí.
Si tu archivo contiene información confidencial la puedes reemplazar por datos genéricos.
Nuevo:
Simular carrito de compras - YouTube
Recomendaciones:
Curso de macros. Cargar datos en un ListBox con formato. - YouTube
Hola Dante!
En orden cronológico ejecuto esas macros.
Private Sub Comprobante2_button_Click()
buscar = Sheets("Ventas").Range("I4").value
[AREA_COPY].Copy 'Rango C15:D40 de la hoja ventas
Sheets("Comprobante 2").Activate
Range("A15").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
End Sub Private Sub Lista_buscador_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim value As Variant
Set lookupRange = Sheets("Productos").Range("Tabla1[DESCRIPCIÓN]")
value = Lista_buscador.List(Lista_buscador.ListIndex, 0)
Set findval = lookupRange.Find(What:=value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
MyVal = findval.Offset(, -1).value
ingrese_cantidad.Show
ingrese_cantidad.TextBox1.Text = ""
ingrese_cantidad.TextBox1.SetFocus
End Sub Dim n As Integer
Dim Z As Range
n = Application.WorksheetFunction.CountA(ActiveSheet.Range("A15:A40"))
If n = 26 Then
MsgBox "Todas las celdas están llenas para poder ingresar un nuevo código", vbInformation + vbOKOnly, "Celdas llenas"
End
End If
If ActiveSheet.Range("A15").value = "" Then
ActiveSheet.Range("A15").value = MyVal
ActiveSheet.Range("A15").Offset(0, 1) = TextBox1.value
ingrese_cantidad.Hide
Else
Set Z = ActiveSheet.Range("A14").End(xlDown).Offset(1, 0)
ActiveSheet.Range("A14").End(xlDown).Offset(1, 0).value = MyVal
Z.Offset(0, 1) = TextBox1.value
ingrese_cantidad.Hide
End IfEn la imagen que adjunte anteriormente, solo figuran dos celdas visualmente con valores, la A15 y la A16, y se observan las celdas A17:A40 vacias, por lo que la macro deberia posicionarse en la celda A17 y rellenar con el dato que selecciona en el userform.
Pero es como que las detecta con valores, por lo tanto quiere irse a la celda A41 bloqueada.
Cuando borro el contenido "vacio" de la celda A17 presionando la tecla suprimir, la macro funciona correctamente y coloca el dato seleccionado en dicha celda.
La línea que tiene el problema es la siguiente:
ActiveSheet.Range("A14").End(xlDown).Offset(1, 0).value = MyVal
Cambia tu código por lo siguiente:
Dim i As Long
Dim b As Boolean
If TextBox1.Value = "" Then
MsgBox "Captura textbox1"
Exit Sub
End If
b = False
i = 15
Do While Range("A" & i).Value <> ""
i = i + 1
Loop
If i > 40 Then
MsgBox "Todas las celdas están llenas para ingresar un nuevo código", vbInformation + vbOKOnly, "Celdas llenas"
Exit Sub
End If
Range("A" & i).Value = MyVal
Range("B" & i).Value = TextBox1.ValuePrueba y me comentas.
Corrección:
Dim i As Long
If TextBox1.Value = "" Then
MsgBox "Captura textbox1"
Exit Sub
End If
i = 15
Do While Range("A" & i).Value <> ""
i = i + 1
Loop
If i > 40 Then
MsgBox "Todas las celdas están llenas para ingresar un nuevo código", vbInformation + vbOKOnly, "Celdas llenas"
Exit Sub
End If
Range("A" & i).Value = MyVal
Range("B" & i).Value = TextBox1.ValueSal u dos
Dante Amor
2 respuestas más de otros expertos
El problema se presenta, no cuando hay vacías, sino cuando todo el rango de la col A está lleno.
Y esto es porque luego del mensaje no le das salida al proceso, sino que continúa. Y como está todo lleno intenta pegar datos en fila 41, que sí está bloqueada.
Por lo tanto tendrás que agregar una instrucción de salida en la comparación de 'n':
Dim n As Integer
Dim Z As Range
n = Application.WorksheetFunction.CountA(ActiveSheet.Range("A15:A40"))
If n = 26 Then
MsgBox "Todas las celdas están llenas para poder ingresar un nuevo código", vbInformation + vbOKOnly, "Celdas llenas"
Exit Sub 'cancela el proceso
End If
'sigue el resto de tu códigoEn lugar del Exit Sub, se lo puede enviar a otra parte del proceso (con un GoTo salida )... esto dependerá de lo que se deba ejecuta en caso de rango lleno.
Para solucionar este problema, puedes desproteger temporalmente las celdas en la hoja "Comprobante 2" antes de realizar la operación de pegado y luego volver a protegerlas después. Aquí tienes una posible modificación de tu código:
Dim n As Integer
Dim Z As Range
' Desproteger la hoja "Comprobante 2"
Sheets("Comprobante 2").Unprotect
n = Application.WorksheetFunction.CountA(ActiveSheet.Range("A15:A40"))
If n = 26 Then
MsgBox "Todas las celdas están llenas para poder ingresar un nuevo código", vbInformation + vbOKOnly, "Celdas llenas"
'End
End If
If ActiveSheet.Range("A15").Value = "" Then
ActiveSheet.Range("A15").Value = MyVal
ActiveSheet.Range("A15").Offset(0, 1) = TextBox1.Value
ingrese_cantidad.Hide
Else
Set Z = ActiveSheet.Range("A14").End(xlDown).Offset(1, 0)
ActiveSheet.Range("A14").End(xlDown).Offset(1, 0).Value = MyVal
Z.Offset(0, 1) = TextBox1.Value
ingrese_cantidad.Hide
End If
' Volver a proteger la hoja "Comprobante 2"
Sheets("Comprobante 2").Protect
' Pegar las celdas copiadas como valores
Sheets("Comprobante 2"). Range("A15").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=FalseEn este código, se agrega la protección y desprotección de la hoja "Comprobante 2" utilizando los métodos Protect y Unprotect. Después de copiar las celdas en el rango "A15:D40" en la hoja "Ventas", se desprotege la hoja "Comprobante 2", se realiza la operación de pegado y luego se vuelve a proteger la hoja.