Antoni

Prueba con esto: Sub TransponerA1SX42() Application.ScreenUpdating = False y = Columns("UT").Column For columna = 1 To Columns("SX").Column x = (columna - 1) * 42 + 1 Range(Cells(x, y), Cells(x + 41, y)).Value = _ Range(Cells(1, columna), Cells(42, columna)).Value Next Columns(y).Sort Key1:=Columns(y) End Sub

Nunca debes utilizar los textbox, la función Val(), ni la función Format() en los cálculos, utiliza las variables y las funciones de conversión del tipo adecuado. He añadido un pequeño calendario. PRUEBA1.xlsm

No se entiende, vuelve a subir el archivo con un ejemplo de lo que tienes y lo que quieres obtener.

Activa la hoja que quieras y ejecuta esta macro: Sub CambioMasivo(): On Error Resume Next Application.ScreenUpdating = False Application.EnableEvents = False For x = 2 To Range("A" & Rows.Count).End(xlUp).Row Set Target = Range("A" & x) Range("B" & Target.Row & ":AW" & Target.Row) = "" With Sheets("N1") Set q = .Columns("A").Find(Target, , , xlWhole) If Not q Is Nothing Then .Range("B" & q.Row & ":AW" & q.Row).Copy Range("B" & Target.Row) End If End With Next Application.ScreenUpdating = True Application.EnableEvent

Debes eliminar tu primer código y sustituirlo por el que te indica ikanni.

Eso depende de la configuración anti SPAM del receptor del mensaje.

Como no subas un archivo Excel con un ejemplo de lo que quieres conseguir, no vas a conseguir ayuda.

Private Sub LlenarListBox() For x = 2 To Range("A" & Rows.Count).End(xlUp).Row B = Split(Range("B" & x), "-") C = Split(Range("C" & x), "-") D = Split(Range("D" & x), "-") With ListBox1 For y = 0 To UBound(B) .AddItem Range("A" & x) .List(.ListCount - 1, 1) = B(y) .List(.ListCount - 1, 2) = C(y) .List(.ListCount - 1, 3) = D(y) Next End With Next End Sub Llama a este procedimiento para llenar el ListBox.

Sub Buscar_dato() Dim encontrado As Range '-- If [C4] = "" Then MsgBox "Introduzca un Número a buscar", vbInformation, "Número vacío" Exit Sub End If '-- [C6:C12] = "" With Sheets("BD") Set encontrado = .Columns("B").Find(What:=[C4], LookAt:=xlWhole) 'xlWhole Busca exacto If Not encontrado Is Nothing Then [C6] = .Cells(encontrado.Row, "C") 'Nombre [C8] = .Cells(encontrado.Row, "D") 'CEDULA [C10] = .Cells(encontrado.Row, "E") 'ESTACIÓN [C12] = .Cells(encontrado.Row, "F") 'BOMBERO Range("A1") = True 'Desactiva el Che

Cada vez que añadas/modifiques en la columna A, se copiarán los datos correspondientes de la hoja N1. Trabajo.1.xlsb

Directamente de la ayuda de vba: Función Array() Nada más que añadir. .

Prueba a ver si es eso. Abre el adjunto y pulsa sobre el rectángulo azul. Modelo2.xlsm

Ya casi lo tengo, pero no será hasta mañana, que aquí donde estoy ya es hora de cenar. 😉

Lo mismo pero de otra forma, suponiendo que tu rango de celdas fuera A1:B6: Do Until WorksheetFunction.CountIf(Range("A1:B6"), ">0") = 0 'Tu macro Loop

😉

Revisa el adjunto. CONTACTOS.xlsm

En la hoja: Private Sub Worksheet_Change(ByVal Target As Range) '--------------------------------- 'Inserta la imagen de la columna A '--------------------------------- If Target.Address Like "$A$*" Then InsertarImagen Target End Sub En un módulo: Sub InsertarImágenes() '-------------------------- 'Inserta todas las imágenes '-------------------------- Dim x As Long For x = 8 To Range("A" & Rows.Count).End(xlUp).Row InsertarIagen Range("A" & x) Next End Sub '------------------------------------------------------- Sub InsertarImagen(Imagen As Range): On Error Resume Next D

Si te entendido bien, esta sería la macro: Sub TraspasarVIN() With Selection .Font.Color = vbRed 'Color rojo a celda activa [L6] = "" [O6] = "" Select Case .Offset(0, 1) Case "Nuevo": [L6] = .Value Case "Antiguo": [O6] = .Value End Select End With End Sub ¡Vaya! parece que he llegado tarde. 😉

Sin el archivo no hay nada que hacer. Revisa las normas del foro, por favor.

En mi PC, 21 segundos cada 1.000 intentos, o sea un montón de horas.

Sube el archivo, nadie se va a generar el entorno para poder probar y responder a tu consulta, al menos yo.

Para contraseñas de 4 posiciones: Ármate de paciencia, hay que probar con hasta cerca de 15.000.000 de posibilidades. Sub Desproteger(): On Error GoTo NoPass Dim L As String, Contraseña As String, Total As Long L = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" Debug.Print Time For A = 1 To Len(L): For B = 1 To Len(L): For C = 1 To Len(L): For D = 1 To Len(L) '------------------------------------------------------ Total = Total + 1 Contraseña = Mid(L, A, 1) & _ Mid(L, B, 1) & _ Mid(L, C, 1) & _ Mid(

¿Y la de ikanni? 😒

En los controles ActiveX en un formulario existe la propiedad .ControlTipText, pero en los controles insertados directamente en la hoja, no. Una solución bastante chapucilla consiste en insertar un label junto al botón con el texto de ayuda, con la propiedad .Visible = False y luego haciendo click derecho sobre el botón para mostrarlo/ocultarlo de forma alternativa. Private Sub CommandButton1_MouseDown(ByVal Button As Integer, _ ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Label1.Visible = Not Label1.Visible End Sub

Hablo por no callar, pero ¿Podría ser esto? Ruta = ThisWorkbook.Path & "\" & ThisWorkbook.Name