JSDJSD
-
Contador de contenido
2416 -
Unido
-
Última visita
-
Días con premio
228
Respuestas de la comunidad
-
JSDJSD's post in AYUDA ima gen e hipervínculo was marked as the answer
El archivo
Propuesta25122024.xlsm
-
JSDJSD's post in al cambiar un campo dentro de un formulario actualizar el valor de otro was marked as the answer
Tal cual veo tu archivo en el formulario MC-Agregar registros, en el comobox Nombre(nomHoja) solamente deberías cargar Berel y Romta, bueno míralo y comentas.
-
JSDJSD's post in BLOQUEAR GUARDAR COMO was marked as the answer
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI Then MsgBox "La opción 'Guardar Como' está deshabilitada", vbExclamation Cancel = True End If End Sub Prueba y comenta
-
JSDJSD's post in Macro para habilitar tabla para agregar filas automaticamente en hoja protegida was marked as the answer
prueba TABLA PROTEGIDA.xlsm tu archivo
-
-
JSDJSD's post in Bloquear TextBox, SpinButton y CommandButton según selección en Combobox was marked as the answer
Prueba y comenta
HHE PRUEBA (3) (1).xlsm
-
-
JSDJSD's post in Mostrar hoja en Listbox según selección en Combobox was marked as the answer
Private Sub ComBanco_Change() Dim hojabuscada As String Dim ultFila As Long Dim ultCol As Long hojabuscada = ComBanco With Sheets(hojabuscada) ultFila = .Cells(.Rows.Count, 1).End(xlUp).Row ultCol = .Cells(6, .Columns.Count).End(xlToLeft).Column LstDiario.RowSource = .Range(.Cells(6, 1), .Cells(ultFila, ultCol)).Address(External:=True) End With End Sub El saldo inicial no se si quieres que se muestre, en caso contrario modifica la macro, simplemente cambia en la dos ultimas líneas del bloque with el 6 por el 7
Para Foro.xlsm
-
JSDJSD's post in Macro Fusionar Hojas de Excel con ordenación was marked as the answer
Sub ConsolidarSeguimientos(): Application.ScreenUpdating = False primeraCopia = True On Error Resume Next Set destino = Sheets("Seguimiento_Anual") If destino Is Nothing Then Set destino = Sheets.Add destino.Name = "Seguimiento_Anual" Else destino.Cells.Clear End If On Error GoTo 0 For Each ws In ThisWorkbook.Worksheets If ws.Name Like "Seguimiento_*" And ws.Name <> "Seguimiento_Anual" Then If Application.WorksheetFunction.CountA(destino.Cells) = 0 Then ultimaFila = 1 Else ultimaFila = destino.Cells(destino.Rows.Count, "A").End(xlUp).Row + 1 End If If primeraCopia Then ws.UsedRange.Copy Destination:=destino.Cells(ultimaFila, 1) primeraCopia = False Else ws.UsedRange.Offset(1, 0).Resize(ws.UsedRange.Rows.Count - 1).Copy _ Destination:=destino.Cells(ultimaFila, 1) End If End If Next ws ultimaFila = destino.Cells(destino.Rows.Count, "A").End(xlUp).Row Dim i As Long For i = ultimaFila To 2 Step -1 If IsEmpty(destino.Cells(i, 3)) Then destino.Rows(i).Delete End If Next i With destino.Sort .SortFields.Clear .SortFields.Add Key:=destino.Range("A2:A" & ultimaFila), Order:=xlAscending .SortFields.Add Key:=destino.Range("B2:B" & ultimaFila), Order:=xlAscending .SetRange destino.Range("A1").CurrentRegion .Header = xlYes .Apply End With destino.UsedRange.Columns.AutoFit MsgBox "Consolidación completada.", vbInformation End Sub
Organización Formaciones Centro (1).xlsm
-
JSDJSD's post in combinar 2 columnas pero solo de celdas seleccionadas was marked as the answer
Sub CombinarCeldaCyD(): Application.DisplayAlerts = False If Selection Is Nothing Then Exit Sub Set Celda = Selection If Celda.Column <> 3 Then Exit Sub TextoC = Celda.Value TextoD = Celda.Offset(0, 1).Value TextoCombinado = TextoC & " " & TextoD Set RangoACombinar = Range(Celda, Celda.Offset(0, 1)) With RangoACombinar .Merge .Value = TextoCombinado End With End Sub
-
-
JSDJSD's post in ocultar todos los tabs de excel was marked as the answer
stock ALMACEN MMPP 2024 rev.1001 (1).xlsm
-
JSDJSD's post in avanzar una celda hacia abajo apartir de una celda seleccionada was marked as the answer
Sub RecorrerRangoC() Set hoja = ActiveSheet Set rango = hoja.Range("C2:C" & hoja.Cells(hoja.Rows.Count, "C").End(xlUp).Row) If rango.Cells.Count = 0 Then MsgBox "No hay datos en la columna C.", vbExclamation Exit Sub End If For Each celda In rango.SpecialCells(xlCellTypeVisible) celda.Select Application.Wait Now + TimeValue("00:00:01") Next celda End Sub Prueba y comenta
-
JSDJSD's post in PLANTILLA DE MACRO DE COMPARACION NUMERICA DE DOS HOJAS DEL MISMO EXCEL was marked as the answer
Ahora mirando veo que ya te han dado solución en el foro amigo
-
JSDJSD's post in sumar horas was marked as the answer
No me queda claro te dejo una prueba a ver si es esto, teniendo en cuenta la jornada laboral de 40 horas semanales si calculamos la primera fila daría como resultado 40 hora y 37 extra, de no ser esto sube un ejemplo de como debería quedar en la primera fila
-
JSDJSD's post in Combinar datos de dos hojas en una con macro en el mismo libro was marked as the answer
A ver si te apañas con esto
-
JSDJSD's post in Variable con Rango de Celdas (Cells) was marked as the answer
Sub Macro1() Dim tablaRef As Range Dim UltimaFila As Long Dim UltimaColumna As Long ' Recogemos valores para las variables de UltimaFila y UltimaColumna With Sheets("Hoja1") UltimaFila = .Cells(.Rows.Count, "C").End(xlUp).Row UltimaColumna = .Cells(3, .Columns.Count).End(xlToLeft).Column Set tablaRef = .Range(.Cells(3, 3), .Cells(UltimaFila, UltimaColumna)) End With ' Seleccionamos la tabla de referencias tablaRef.Select End Sub No lo he probado, prueba y comenta
-
JSDJSD's post in Cambiar numero consecutivo en textos was marked as the answer
Private Sub Worksheet_Change(ByVal Objetivo As Range) With Hoja1 If Not Intersect(Objetivo, .Range("E3")) Is Nothing Then Application.EnableEvents = False nuevoValor = Objetivo ultimaFila = .Cells(.Rows.Count, "D").End(xlUp).Row For i = 4 To ultimaFila textoActual = .Cells(i, "D") posicionPunto = InStr(1, textoActual, ".") If posicionPunto > 0 Then textoDespuesPunto = Mid(textoActual, posicionPunto + 1) .Cells(i, "D") = nuevoValor & "." & textoDespuesPunto End If nuevoValor = nuevoValor + 1 Next i Application.EnableEvents = True End If End With End Sub
Cambio automatico de numeros.xlsm