Poner línea debajo de celda en rango.

[pinoji]

Hola colegas, buenas tardes y que tengan una excelente salud.

Tengo un pequeño proyecto para controlar los comensales, pero necesito una hoja para llevar de manera manual las incidencias. ya tengo hecho todo, excepto que necesito en la Hoja Modelo, en la columna E me ponga una linea en la parte inferior de las celdas (Para Firmar), siempre que existan datos.

Yo tengo este código:

Private Sub BtnImprimirM_Click()
Dim X As Long
Application.ScreenUpdating = False
Hoja10.Range("A4:D5000").Clear
Worksheets("BD Alumnos").Range("A4:D5000").Copy Worksheets("Modelo").Range("A4")
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
'    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
'    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
'    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
'    Selection.Borders(xlEdgeTop).LineStyle = xlNone
'    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
'    Selection.Borders(xlEdgeRight).LineStyle = xlNone
'    Selection.Borders(xlInsideVertical).LineStyle = xlNone
'    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("B4:D5000").Select
    ActiveWorkbook.Worksheets("Modelo").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Modelo").Sort.SortFields.Add2 Key:=Range("D4:D5000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Modelo").Sort
        .SetRange Range("B3:D5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A4").Select
    MsgBox "Datos Actualizados e Imprimiendo...", vbInformation, "Sistemas COLOSSUS"
        
    Sheets("Modelo").Select
    X = Application.Dialogs(xlDialogPrinterSetup).Show
    If X = False Then Exit Sub
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
    IgnorePrintAreas:=False
Application.ScreenUpdating = True
End Sub

Pensé crear una varibale para determianr la última fila, pero aun así, despues de varios intentos no logré hacerlo. Este listado puede variar con más o menos trabajadores diarios.

Por favor, si me pueden ayudar se los agradeceré.

Adjunto archivo.

Mis respetos.

Pino

Resumen de Comensales Lavandería JSD.xlsm

[JSDJSD]

No se si te refieres a esto

Private Sub Worksheet_Change(ByVal Target As Range): On Error Resume Next: Application.ScreenUpdating = False
    With Hoja10
        For Cont = 4 To .Range("A" & Rows.Count).End(xlUp).Row
            If .Cells(Cont, 5) <> "" Then
                .Cells(Cont, 5).Borders(xlEdgeBottom).Weight = xlThick
            Else
                .Cells(Cont, 5).Borders(xlEdgeBottom).LineStyle = xlNone
            End If
        Next Cont
    End With
End Sub

 

Resumen de Comensales Lavandería JSD(1).xlsm

[JSDJSD]

Usa mejor este código

Private Sub Worksheet_Change(ByVal Target As Range): On Error Resume Next: Application.ScreenUpdating = False
    With Hoja10
        If Not Intersect(Target, .Range("E5", "E" & .Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
            For Cont = 4 To .Range("A" & Rows.Count).End(xlUp).Row
                If .Cells(Cont, 5) <> "" Then
                    .Cells(Cont, 5).Borders(xlEdgeBottom).Weight = xlThick
                Else
                    .Cells(Cont, 5).Borders(xlEdgeBottom).LineStyle = xlNone
                End If
            Next Cont
        End If
    End With
End Sub

 

[pinoji]

Buenos días colegas, espero se encuentren bien de salud.

Buenos días profesor JSD, espero se encuentre bien salud al igual que su familia.

No precisamente es lo que necesito, pero me dio una excelente idea para una plantilla que tengo con otros fines.

Para el caso que nos ocupa, es un Modelo que se imprime y se ubica en el Restaurant Obrero para que cada trabajador firme en el lugar que corresponda y así deja constancia de que hizo uso del comedor. O sea, la macro copia de la Hoja 1 las columnas A, B, C y D, los copia a la Hoja 10 y ordena por Categoría, pero este listado puede crecer o decrecer, hoy pueden almorzar 75 personas, pero mañana pueden ser 60 y lo que quiero es que me subraye en la columna E las filas o celdas que contengan datos en las columnas anteriores.

No se si me di a entender.

Gracias mil por su pronta ayuda.

Un saludo y mis respeto

Pino

[JSDJSD]

Sube un ejemplo manual en el que se vea el antes y el despues

[pinoji]

Buenas noches "Padrino", lo que necesito es que según la cantidad de filas con datos en la hoja 1, lo traiga a la hoja 10 y y en la columna D cada una de esas filas marque el borde inferior de cada celda. Es solo para que cada uno de los comensales firme. 

En el código que yo le envié hace todo lo que necesito, o sea, copia el rango de la hoja 1, lo pegas en la hoja 10 y lo organiza AZ por la columna C, solo me falta que me defina la cantidad de registros y en la columna D me subraye en la parte inferior.

Ahora estoy desde mi móvil, pero para el lunes le envío una muestra de lo que necesito.

Gracias profesor por su tiempo y que tenga un excelente fin de semana.

Mis saludos y respeto.

Pino.

 

 

[pinoji]

Buenas noches colegas. Espero se encuentren bien de salud. Buenas Noches profesor, amigo y padrino JSD. Esto es lo que pretendo hacer.:

Copia el rango de datos de la Hoja1, lo pega en la Hoja10, ordena por Categoría (columna D (A-Z)) y a partir de ahí quiero que me coloque en cada celda de dicha columna D que contenga datos el Borde Inferior.

Como siempre hago lo he intentado; traté de usar un ciclo For/Next (i) que me recorra cada una de las celdas con datos y anidar un condicional IF/Else/End If para que cuando la celda (i) de la columna 3 (C) no esté vacía (<> “”) me ejecute en la columna D el borde inferior a cada celda en el recorrido de la variable i

.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

 .Weight = xlThin

Por supuesto, creé una variable para hallar la ultima fila con datos, pero a pesar de que no me da error, tampoco me ejecuta lo que quiero hacer. Esto es a groso modo lo que necesito. Realmente esto no es nada importante, más bien es por estética lo que quiero hacer y además aprendo algo más que quizás en algún otro Proyecto futuro lo pueda necesitar.

Un saludo y mis respetos.

Feliz fin de semana

Pino 

adjunto muestra Foro.docx

 

 

 

 

 

 

[JasallBcn]

Buenas, una manera de solucionarlo es ponerle un formato condicional .

 

saludos

 

Resumen de Comensales Lavandería JSD_v1.xlsm

[JasallBcn]

Buenas, te lo paso también con un ciclo For como lo querías hacer desde el principio

    ' pintar lineas
    Dim i As Long
    Range("E:E").ClearFormats
    For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
     Range("E" & i).Borders(xlEdgeBottom).LineStyle = 1
    Next
    '

saludos

 

Resumen de Comensales Lavandería JSD_v2.xlsm

[JSDJSD]

Prueba y comenta

Private Sub CommandButton1_Click(): Application.ScreenUpdating = False
    With Hoja10
        .Range("A1").CurrentRegion.Offset(1, 0).Clear
        Hoja1.Range("A1").CurrentRegion.Offset(3, 0).Copy Destination:=.Range("A2")
        .Cells.Sort Key1:=.Columns(4), Header:=xlYes
         For Cont = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            If .Cells(Cont, 4) <> "" Then .Cells(Cont, 5).Borders(xlEdgeBottom).Weight = xlThick
         Next Cont
    End With
End Sub

 

Resumen de Comensales Lavandería JSD.xlsm

[pinoji]

Buenos días colegas, espero se encuentren bien de salud.

Buenos días amigo Jasall, excelente solucióm, realmente no había pensado en el formato condicional que es una formidable "herramienta." Gracias por su aporte.

Buenos días profesor JSD, exactamente eso era lo que necesitaba. Evidentemente revisando el código que usted me sugiere y comparando con uno que hice me doy cuenta que cometí algunos errores u omisiones.

Gracias por todo.

Tengo una duda en el Proyecto  de Ropa Sucia que usted me ayudó en su momento, pero lo haré en un nuevo tema.

Mis respetos.

Pino