Para Dante, Dar MsgBox si no se ingreso un dato en una celda excel.

Hola! Dante 

Nuevamente solicitando tu gran ayuda, como puedo adaptar a la macro que me diste un Msgbox indicando "Son muy pocos datos para guardar" entre la celdas "A5:bY5" , si se llenaron todos los datos en las celdas este se guardara correctamente y si no se llenaron que me mande el mensaje.

La macro que me diste fue este.

Sub addend()
    Application.ScreenUpdating = False
    'Para copiar de hoja1 a hoja2
    Hoja2.Range("A5:bY5").Copy
    'Obtenemos la última fila de la hoja2
    uf = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1
    'Pegamos
    Hoja2.Range("A" & uf).PasteSpecial Paste:=xlPasteValues
    rpta = MsgBox("Se guardaron los datos" & vbNewLine & "Desea Limpiiar las celdas", vbYesNo + vbInformation)
    If rpta = vbYes Then
    'Limpia las celdas
    rango = "D5:H6,D7:E11,C9,H7:H11,F10:G11,I10:I11,F8:G8,J5:J11,K5:L6,M7,N10:N11,O12:O13,P13:Q13,C14:E19"
    Sheets("INGRESO Data").Range(rango).ClearContents
    Else
 End If
End Sub

1 respuesta

Respuesta
1

¿Pero cuáles celdas quieres validar?

Desde la "A" hasta la "BY" hay 77 celdas, ¿quieres validar todas?

Esta es una opción, cambia el 10 por el número mínimo de celdas en blanco que permites

Sub addend()
    Application.ScreenUpdating = False
    For i = 1 To Columns("BY").Column
        If Cells(5, i) = "" Then n = n + 1
    Next
    If n > 10 Then
        MsgBox "Son muy pocos datos para guardar"
    Else
        'Para copiar de hoja1 a hoja2
        Hoja2.Range("A5:bY5").Copy
        'Obtenemos la última fila de la hoja2
        uf = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1
        'Pegamos
        Hoja2.Range("A" & uf).PasteSpecial Paste:=xlPasteValues
        rpta = MsgBox("Se guardaron los datos" & vbNewLine & "Desea Limpiiar las celdas", vbYesNo + vbInformation)
        If rpta = vbYes Then
            'Limpia las celdas
            rango = "D5:H6,D7:E11,C9,H7:H11,F10:G11,I10:I11,F8:G8,J5:J11,K5:L6,M7,N10:N11,O12:O13,P13:Q13,C14:E19"
            Sheets("INGRESO Data").Range(rango).ClearContents
        End If
    End If
End Sub

Hola! Dante

Gracias por la respuesta que me diste, en realidad son ciertas celdas a las que quiero poner esta condición y estas celdas son las siguientes.

"D5:H6,D7:E11,C9,H7:H11,F10:G11,I10:I11,F8:G8,J5:J11,K5:L6,M7,N10:N11,O12:O13,P13:Q13,C14:E19" 

Si en una de ellas no se encuentra escrita un dato que me mande el mensaje.

Gracias, y disculpa por no ser tan claro en la pregunta ya que cometí el error de poner las celdas equivocadas de "A5:BY5". ESAS NO SON LAS CORRECTAS. 

Hola! Dante

Utilice esta otra opción pero seria muy largo para todas las celdas que se requiere no se si se puede hacer de otra manera pero para todas las celdas ya mencionadas anteriormente.

Sub addend()
    If Range("D5") = "" Or Range("J5") = "" Or Range("E19") = "" Then
    MsgBox "No son Datos Suficientes para Guardar", vbInformation, ""
    Else
    Application.ScreenUpdating = False
    'Para copiar de hoja1 a hoja2
    Hoja2.Range("A5:bY5").Copy
    'Obtenemos la última fila de la hoja2
    uf = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1
    'Pegamos
    Hoja2.Range("A" & uf).PasteSpecial Paste:=xlPasteValues
    rpta = MsgBox("Se guardaron los datos" & vbNewLine & "Desea Limpiiar las celdas", vbYesNo + vbInformation)
    If rpta = vbYes Then
    'Limpias
    rango = "D5:H6,D7:E11,C9,H7:H11,F10:G11,I10:I11,F8:G8,J5:J11,K5:L6,M7,N10:N11,O12:O13,P13:Q13,C14:E19"
    Sheets("INGRESO Data").Range(rango).ClearContents
    Else
 End If
 End If
End Sub

Con esto validas todas las celdas que quieres

Sub addend()
'Por.Damte Amor
    Set celdas = Range("D5:H6,D7:E11,C9,H7:H11,F10:G11,I10:I11,F8:G8,J5:J11,K5:L6,M7,N10:N11,O12:O13,P13:Q13,C14:E19")
    For Each c In celdas
        If c = "" Then
            blanco = True
            Exit For
        End If
    Next
    If blanco Then
        MsgBox "No son Datos Suficientes para Guardar", vbInformation, ""
    Else
        Application.ScreenUpdating = False
        'Para copiar de hoja1 a hoja2
        Hoja2.Range("A5:bY5").Copy
        'Obtenemos la última fila de la hoja2
        uf = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1
        'Pegamos
        Hoja2.Range("A" & uf).PasteSpecial Paste:=xlPasteValues
        rpta = MsgBox("Se guardaron los datos" & vbNewLine & "Desea Limpiiar las celdas", vbYesNo + vbInformation)
        If rpta = vbYes Then
            'Limpias
            rango = "D5:H6,D7:E11,C9,H7:H11,F10:G11,I10:I11,F8:G8,J5:J11,K5:L6,M7,N10:N11,O12:O13,P13:Q13,C14:E19"
            Sheets("INGRESO Data").Range(rango).ClearContents
        End If
     End If
End Sub

.

¡Gracias! Dante

Que tengas tu también unas Felices fiestas!

El código esta perfecto justo lo que quería, doy por finalizado este tema. 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas