Antoni

También valdría, o eso creo: Sub ExtraerDatosNOfacturar() Dim Fila As Long For Fila = 3 To Hoja1.Range("A" & Rows.Count).End(xlUp).Row If Hoja1.Range("AA" & Fila) = "NO SE REMITE" And _ Not Hoja1.Range("AF" & Fila) = "NO VENDIDAS" Then Hoja1.Rows(Fila).Copy _ Hoja2.Rows(Hoja2.Range("A" & Rows.Count).End(FilalUp).Row + 1) Hoja1.Rows(Fila).Delete Fila = Fila - 1 End If Next End Sub

Sub LinkToResumen() Application.ScreenUpdating = False For Each hoja In Sheets If Not hoja.Name = "RESUMEN" Then Set cliente = Sheets("RESUMEN").Columns("A").Find(hoja.Name, , , xlWhole) If Not cliente Is Nothing Then hoja.Hyperlinks.Add Anchor:=hoja.Range("A1"), Address:="", _ SubAddress:="RESUMEN!" & cliente.Address, TextToDisplay:="RESUMEN" End If End If Next Application.ScreenUpdating = True End Sub

Sub CopiarBase() Dim Fila As Long Dim no As Range Application.ScreenUpdating = False Set no = Hoja2.Columns("A").Find(Hoja1.Range("A4"), , , xlWhole) If Not no Is Nothing Then Fila = no.Row Else Fila = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1 End If Hoja2.Range("A" & Fila) = Hoja1.Range("A4") Hoja2.Range("B" & Fila) = Hoja1.Range("B4") Hoja2.Range("C" & Fila) = Hoja1.Range("C4") Hoja2.Range("D" & Fila) = Hoja1.Range("D4") Hoja2.Range("E" & Fila) = Hoja1.Range("E4") Application.ScreenUpdating = True End Sub

Pon un ejemplo concreto del procedimiento a efectuar y de los resultados a obtener, porqué no se entiende lo que quieres hacer.

No dices que celdas, no dices que hojas, no subes un archivo con un ejemplo de lo que quieres. Así es imposible ayudarte.

Pues ya estoy aquí. Seleccionar un temario de la lista y pulsar Comenzar. Aparecerá una pregunta en la celda J14. Responder en la celda J16 y pulsar Responder o pulsar Pasa Palabra. Si quereis jugar con tiempo, llenar la celda L23. de lo contrario informar cero. El rango de celdas L6:L11 controla los colores del Rosco. La columna L puede ocultarse. Pasa palabra full.xlsm

Quita la comilla simple al principio de la instrucción '.Send

El tipo 2 de SpecialCells corresponde a valores fijos y tus celdas son el resultado de una fórmula, por lo que no seleccionan. Te dejo la macro preparada para cualquier número de filas. ' Declaramos variables ' Dim OutlookApp As Outlook.Application Dim MItem As Outlook.MailItem Dim cell As Range Dim Asunto As String Dim Correo As String Dim Destinatario As String Dim Saldo As String Dim Msg As String ' Set OutlookApp = New Outlook.Application ' 'Recorremos la columna EMAIL 'Desde la celda B11 hasta el final For Each cell In Range("B11:B" & Range("B" & Rows.Count).End(xlUp).Row) ' 'Asignamos valor a las variables ' If cell Like "*@*" Then 'Comprobamos si es una dirección de correo Asunto = "Saldo vencido" Destinatario = cell.Offset(0, -1).Value Correo = cell.Value Saldo = Format(cell.Offset(0, 1).Value, "$#,##0") FechaVencimiento = Format(cell.Offset(0, 2).Value, "dd/mmm/yyyy") ' 'Cuerpo del mensaje ' Msg = "Apreciable " & Destinatario & vbNewLine & vbNewLine Msg = Msg & "Queremos informarle que su fecha de pago venció el día " Msg = Msg & FechaVencimiento & "." & vbNewLine & vbNewLine Msg = Msg & "El saldo que debe liquidar es " Msg = Msg & Saldo & vbNewLine & vbNewLine Msg = Msg & "Atentamente:" & vbNewLine Msg = Msg & "Tarjetas de crédito." ' Set MItem = OutlookApp.CreateItem(olMailItem) With MItem .To = Correo .Subject = Asunto .Body = Msg '.Send ' End With End If ' Next ' End Sub

En el rango Range("B11:B13") no hay información, de ahí el error.

Ejecuta la macro CompletarInfo: Sub CompletarInfo() Dim DNI As Range, Número As Range Application.ScreenUpdating = False With Sheets("Hoja1") For Each DNI In .Range(.Range("A3"), .Range("A" & Rows.Count).End(xlUp)) Set Número = Sheets("BOLETAS").Columns("B").Find(DNI, , , xlWhole) If Not Número Is Nothing Then Completar DNI, Número Set Número = Sheets("BOLETAS").Columns("L").Find(DNI, , , xlWhole) If Not Número Is Nothing Then Completar DNI, Número Next End With End Sub '-- Private Sub Completar(DNI As Range, Número As Range) Número.Offset(2, 1) = DNI.Offset(0, 2) Número.Offset(9, 4) = "Sueldo y/o jornal" Número.Offset(9, 6) = DNI.Offset(0, 3) End Sub

Estate atento, durante este fin de semana le añadiré el tiempo de juego y la función Pasa palabra.

Aquí os dejo una mini facturación. Colocar el nombre del impuesto añadido en la ceda H1 y el porcentaje en la celda I1 de la hoja Trabajo. Si vuestra facturación no tiene impuesto añadido, poner a cero la celda I1 de la hoja Trabajo. La hoja Trabajo puede ocultarse. Cambiando el título de los label del formulario, la aplicación también valdría como entrada de albaranes. Mini facturación.xlsm

Revisa el adjunto. Si te interesa ponerle tiempo, comentas. Pasa palabra 1.xlsm

Si, pero sube un archivo y pon un ejemplo manual de como debería funcionar lo que quieres hacer.

Te dejo un ejemplo para 3 círculos: ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", "Oval 3")).Fill.ForeColor.RGB = vbRed Si solo tienes los 10 círculos en la hoja, esta forma te permite hacer lo mismo prescindiendo del nombre de la autoforma. ActiveSheet.Shapes.SelectAll Selection.ShapeRange.Fill.ForeColor.RGB = vbRed

No cerreis que estoy en ello.

Selection.AutoFill Destination:=Range(Range("K2"), Range("K2").End(xlDown)) Range(Range("K2"), Range("K2").End(xlDown)).Select Revisa toda la macro por si hubiera más instrucciones con este error. Si no te funciona, comentas.

Selection.AutoFill Destination:=Range(Range("K2"), Range("K2").End(xlDow)) Range(Range("K2"), Range("K2").End(xlDow)).Select

Prueba con: =SI(CONTARA(I2:I5)>0;"*";"") .

Abre el adjunto y pulsa sobre el botón Traspasar vales. Aparece un formulario con las hojas susceptibles de ser traspasadas. El formulario detecta de forma automática los dos formatos, también detecta si el vale ya ha sido traspasado con anterioridad. Multi Lote auto.xlsm

Fin del día de la marmota. Has pedido una macro, pues aquí está la macro. Sub CompararFechas() Application.ScreenUpdating = False For x2 = 2 To Hoja2.Range("A" & Rows.Count).End(xlUp).Row For x1 = 2 To Hoja1.Range("A" & Rows.Count).End(xlUp).Row Hoja2.Range("G" & x2) = "" If Hoja2.Range("A" & x2) = Hoja1.Range("A" & x1) Or _ Hoja2.Range("E" & x2) = Hoja1.Range("A" & x1) Or _ Hoja2.Range("A" & x2) = Hoja1.Range("E" & x1) Or _ Hoja2.Range("E" & x2) = Hoja1.Range("E" & x1) Then If (Not Hoja2.Range("C" & x2) < Hoja1.Range("C" & x1) And _ Not Hoja2.Range("C" & x2) > Hoja1.Range("D" & x1)) Or _ (Not Hoja2.Range("D" & x2) < Hoja1.Range("C" & x1) And _ Not Hoja2.Range("D" & x2) > Hoja1.Range("D" & x1)) Then Hoja2.Range("G" & x2) = "Trabajador y/o suplente ya asignados en fila " & x1 Exit For End If End If Next Next End Sub

Prueba el adjunto. Si tienes demasiadas hojas a tratar, quizás sería mejor excluir las que no quieras. Podría intentarse que se detectaran los 2 formatos de forma automática. SI te interesa, comentas. Libro1-EJEMPLO--8 (1).xlsm

Revisa el adjunto. He añadido estas macros en la hoja Inicio. Dim Cartas() As Integer Dim Índice As Integer Private Sub cmdBarajear_Click() 'Evento click del botón Barajear <------------------ ReDim Cartas(Hoja2.UsedRange.Rows.Count) Inicio: n = Int(Hoja2.UsedRange.Rows.Count * Rnd) + 1 For x = 0 To UBound(Cartas) If Cartas(x) = n Then GoTo Inicio If Cartas(x) = 0 Then Cartas(x) = n If x = UBound(Cartas) - 1 Then Exit For GoTo Inicio End If Next Índice = 0 End Sub Private Sub cmdSiguiente_Click() 'Evento click del botón Siguiente '<---------------------- imgCartas.Picture = LoadPicture(Hoja2.Range("B" & Cartas(Índice))) Índice = Índice + 1 If Índice > UBound(Cartas) - 1 Then Índice = UBound(Cartas) - 1 End Sub Loteria.xlsm

Documéntate acerca del método Getrows del objeto Recordset que permite dejar una consulta SQL en un Array. Consulta cualquier tutorial de ADO en la red.

Para empezar modifica el diseño de tus hojas como están en el adjunto. Los adornos y las macros no se llevan bien. Libro1 (4).xlsx