Search the Community

Hola a todos, si alguien me pudiera ayudar a modificar una macro que encontré por ahí, la cual consolida varias columnas en una sola, para ello primero se tiene que seleccionar el rango a consolidar y luego ejecutamos la macro y la consolidación se realiza justo en la columna siguiente del rango seleccionado y lo que deseo es que la consolidación se realice pero no en la columna siguiente si no en la tercera columna siguiente del rango seleccionado. Muchas gracias Sub rango_columnas() 'macro une varias columnas en una sola columna 'para ello primero seleccionamos el rango a unir 'y luego ejecutamos la macro Dim rango As Variant Dim i As Long, j As Long, k As Long Dim col As Long rango = Selection.Value 'Esta es la parte que permite ubicar la salida col = Selection.Column k = Selection.Row 'Esto recorre el rango y realiza la trasposición For i = 1 To UBound(rango, 1) For j = 1 To UBound(rango, 2) Cells(k, col + UBound(rango, 2)).Value = rango(i, j) k = k + 1 Next Next End Sub

Hola buenas. Necesitaria una macro para copiar pegra de una hoja a otra con un criterio. Copiar pegar L:R si en R >0 Salud2.

Buenas noches, me podéis ayudar con esta macro? es para generar codigo de barras, la cuestion que solo me funciona de la siguiente manera: Code128 20, 20, 20, 1.1, ThisWorkbook.ActiveSheet, "11Q94PTT" Pero me gustaría que se cambiara con un rango de una celda. ¿ seria posible algo asi? pero me da error Code128 20, 20, 20, 1.1, ThisWorkbook.ActiveSheet.Range("=F1C1") y mil gracias code128.rar

Estimados Amigos, Buenas tardes, tengo una pregunta sobre como podría optimizar una macro que recorre 300.000 registros y concatena información con el siguiente código: Sub ConcatenaColumnas() Dim numzeros As String numzeros = "0000000000" Range("A:B").Select Selection.NumberFormat = "@" Range("E3").Select '------------------Columna Validación-------------------------------------------------------------------------------------------- Do While ActiveCell <> "" 'Bucle hasta la celda este en blanco ''de la celda activada retroceder xx números (0, -xx) a la izquierda y escribir fórmula ActiveCell.Offset(0, -4).FormulaR1C1 = _ Format(ActiveCell.Offset(0, 0), "dd") & Format(ActiveCell.Offset(0, 0), "mm") & Format(ActiveCell.Offset(0, 0), "yyyy") _ & Left(numzeros, 10 - Len(ActiveCell.Offset(0, 3))) & ActiveCell.Offset(0, 3) _ & Left(numzeros, 10 - Len(ActiveCell.Offset(0, 4))) & ActiveCell.Offset(0, 4) _ & ActiveCell.Offset(0, 5) _ & ActiveCell.Offset(0, 6) ActiveCell.Offset(0, -3).FormulaR1C1 = _ ActiveCell.Offset(0, 2) _ & ActiveCell.Offset(0, 6) _ ActiveCell.Offset(1, 0).Select Loop End Sub El código recorre la celda del rango "e3" validando que tenga información y concatena creando una cadena de texto en el rango (a1), sin embargo ha tardado 12 minutos en cumplir la tarea. Alguien podría darme una mano para poder optimizar el código, sin recurrir a power bi o pivot? De antemano muchas gracias.

Buen día gente del foro, acá estoy con otra consulta: le asigné a una figura que está en la hoja "Busqueda B.VENTAS" una macro para que me dirija a la celda G4 de esa misma hoja, pero ahora sumé otra hoja y necesito agregarle a ese código un condicional que evalúe: si el valor de la celda H3 que está en la hoja "VENTAS" es mayor a 21 entonces me debería dirigir a la celda G4 de hoja "Busqueda B.VENTAS" (que es donde está el botón) y si es menor o igual, que me lleve a la hoja "FACTURA MEDIA" en la celda G4. Desde ya muchas gracias Ejemplo.xlsm

Estimados quien sabe como puedo acelerar el procedimiento para guardar registros, ya que el archivo adjunto realiza lo que quiero con pocos registros, pero si coloco mas registros en la hoja, se me queda pegado el excel y se demora en guardar, como a las 3 o 4 minutos para terminar el procedimiento. ¿Hay algún proc mas efectivo? La idea es llevar los registros visualizados en la hoja excel a una tabla de una base de datos SQLite. Libro1.xlsm

Buenos días, A ver si alguien me puede ayudar con esta macro : Lo que necesito es poner la ruta que hay + todas las subcarpetas que hay después de \2019 Pedidos\..... y no se como hacerlo, Gracias de antemano Sub Proceso_hipervínculo_al_pedido() Ruta = "\\192.169.11.18\RecursosCompartidos\ADMINISTRACION-VENTAS\Interdepartamental\2019 Pedidos\" parte = ActiveCell.Value Set fso = CreateObject("scripting.filesystemobject") Set carpeta = fso.getFolder(Ruta) For Each archivo In carpeta.Files If archivo.Name Like "*" & parte & "*" And Right(archivo, 3) = "pdf" Then Shell "C:\Program Files (x86)\Adobe\Acrobat DC\Acrobat\Acrobat.exe " & archivo, vbNormalFocus Exit Sub Else End If Next MsgBox "No existe pdf" End Sub

Hola que tal saludos a todos a través de sql y usando excel, requiero consultar la cantidad de la ultima compra de un cliente,intente usando esta sentencia pero no sirve: Sub Compras_anterior() ABRIR_RS Sql = "select Max(FECHA) as Next_Date,[CANTIDAD COMPRA] from [Registros$]R WHERE R.cliente='" & UserForm1.Cliente & "' and" & _ " R.Asesor='" & UserForm1.ComVendedor.List(UserForm1.ComVendedor.ListIndex, 1) & "'" & _ " group by [CANTIDAD COMPRA]" Rs.Open Sql, Cnn, 1, 1 If Rs.RecordCount > 0 Then Rs.MoveLast UserForm1.Compra_anterior = Rs.Fields(1) End If Conexion.CERRAR_RS End Sub si alguno sabe como se puede, agradezco de su valiosa ayuda,adjunto el archivo de ejemplo,luego de seleccionar el asesor o vendedor,darle click al check luego nos traerá la cantidad de la ultima compra de el cliente,pero en esto ultimo he fracasado : ( ultima compra.xlsm

Buenas noches, hace unos días pedí una macro y gentilmente Gerson la hizo y funcionó muy bien en el ejemplo, el tema es que cuando lo quiero aplicar en mi archivo no funciona, tira el error "Se ha producido el error '1004' en tiempo de ejecución: error definido por la aplicación o el objeto" Pintando de amarillo la línea que pongo en negrita: Sub ARREGLAR() With Hoja2 'BD BOL VENTAS f = Hoja1.[E16] .Range(.Cells(f, "A"), .Cells(f, "K")) = Hoja1.[BF4:BP4].Value End With End Sub El problema será porque tengo 19 hojas en el libro y en el ejemplo hay solo 2? o por los nombres de las hojas?, no se. Probé agregarles más hojas al ejemplo y sigue funcionando bien, desgraciadamente no puedo subir mi archivo porque es muy pesado Adjunto el ejemplo funcionando bien, por si sirve de algo Desde ya muchas gracias y cualquier dato mas que necesiten saber para encontrar el problema pregunten Saludos Jose Ejemplo.xlsm

Buen día gente del foro, acá vengo con otra inquietud, quería saber si hay una forma (seguramente la hay) de hacer esto: tengo un rango horizontal de datos (BF4:BP4), necesito una macro para copiar los valores de dicho rango y pegarlo en otra hoja del mismo libro, hasta ahí para mi es facil, lo que no se como hacer es que quisiera que lo pegue en una fila concreta, que se determinará por el valor numérico que ingresemos en la celda (E16), osea, el número que ingresemos en (E16) sería el número de la fila donde quiero que pegue los valores del rango. Adjunto un ejemplo para que lo puedan interpretar mejor, si no soy claro háganmelo saber Desde ya muchas gracias Saludos Jose Libro1.xlsx

Buenos dias, Hace unos dias me ayudaron con una archivo y los botones de opcion, ahora tengo el problema (que en el aterior no me pasaba) que lo que pongo en el formulario no se braga como numero en excel, y lo necesito como numero para una serie de hojas que vienen desde la Data, que comando puedo utilizar para que cuando le de "guardar" lo haga como numero. Todo en formato numero a excepción de fecha y palabras que no tengo problema. Gracias. Variables.xlsm

Buenos días: Trabajo en una Institución educativa que desea apropiarse mi trabajo realizado en vba. El archivo contiene varias hojas que se muestran según la contraseña que se ingrese, y a su vez, cada hoja tiene diferentes funcionalidades según su propósito. Consulté un tema similar abierto anteriormente donde se menciona un ofuscador para todo el código contenido en un archivo ( ), sin embargo, al aplicarlo me genera un error 1004 en tiempo de ejecución y al abrir el editor me indica error en la siguiente línea: Set Proyecto = ActiveWorkbook.VBProject. Finalmente el resultado es que no puedo aplicar el ofuscador. Me pueden orientar por favor qué es lo que sucede? Agradezco su atención al presente, saludos a todos.

Buenos dias, teng 2 consulta 1-tengo un formulario donde tengo varios botones de opción, necesito que la opción que escoja el usuario se grabe en una celda de excel en especifico 2-Hay una etiqueta que necesito tambien grabar en una celda en excel (la etiqueta de descripción) Variables.xlsm

Buenas tardes!!! Me podéis echar una mano para crear una macro que haga lo mismo que la formula??. La fórmula lo que hace es contar los artículos diferentes de un mismo cliente. Pensaba que con la formula iba a ir muy bien pero…al tener tantas filas en algunas de las hojas ( aprox. 8000 líneas ) tarda mucho la macro. Gracias de antemano. Un saludo, Ejemplo02.xlsx

Hola a todos, si alguien me puede ayudar con lo siguiente: Tengo una hoja con varias boletas de pago, la cual su rango es variable y lo que necesito es establecer el rango de impresión, tal como se muestra en el archivo adjunto. Muchas gracias. BOLETAS.xls

buenas tardes, escribo con la finalidad de solicitar ayuda en cuanto a una base de datos en la cual tengo 11 columnas de las cuales las 7 primeras tienen valores duplicados, y en las 4 ultimas estos valores deben sumarse al eliminar duplicados. cargo un excel con dos hojas, Hoja1 como se muestran los duplicados y Hoja2 como debería ser el resultado. espero me puedan colaborar con esta base de datos. Gracias de antemano Prueba Utilidades.rar

Buenas noches comunidad del foro por solicitarles su colaboración. Como podría aplicar criterio para filtrar información de un determinado código, es decir solo aquellos que cuenten con el código ACAI, ACAP, ACAK. Actualmente aplico el Criterio para cada uno de ellos: Criteria1:=Array("ACAI-072", "ACAI-084", "ACAI-106", "ACAI-107", "ACAI-109", "ACAI-197", "ACAI-198", "ACAI-199", "ACAI-205", "ACAI-219", "ACAK-120R1", "ACAK-121", "ACAK-122", "ACAK-123", "ACAK-124", "ACAK-125", "ACAK-180", "ACAK-181", "ACAK-182", "ACAK-183", "ACAP-056", "ACAP-100", "ACAP-103", "ACAP-175", "ACAP-176", "ACAP-177", "ACAP-179"), _ Operator:=xlFilterValues Diariamente tengo que ir agregando el código con su respectivo número que le antecede para poder filtrar. A la espera de sus comentarios les quedo agradecido PARAMETROS.xlsm

Hola a todos!! He grabado la siguiente macro pero cuando quiero cambiar la sentencia me da error. "Selection.AutoFill Destination:=Range("K2:K631256") Range("K2:K631256").Select Selection.AutoFill Destination:=Range("K2").End(xlDow) Range("K2").End(xlDow).Select Os pongo la macro entera a continuación. Muchas gracias de antemano por la ayuda. Sub AÑADIRFORMULASFUENTEDEDATOS() ' Columns("J:J").Select Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :=".", FieldInfo:=Array(Array(1, 2), Array(2, 1)), TrailingMinusNumbers:=True Columns("K:K").Select Selection.Delete Shift:=xlToLeft Range("K1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ActiveCell.FormulaR1C1 = "NUM_MES" Range("J3").Select Columns("K:K").ColumnWidth = 42.57 Range("K2").Select ActiveCell.FormulaR1C1 = _ "=VLOOKUP(CONCATENATE(YEAR(RC[-2]),""_"",MONTH(RC[-2])),AUX!R1C1:R25C2,2,FALSE)" Range("K2").Select Selection.AutoFill Destination:=Range("K2:K631256") Range("K2:K631256").Select Columns("K:K").ColumnWidth = 24.43 Range("L1").Select Columns("L:L").ColumnWidth = 23.43 With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ActiveCell.FormulaR1C1 = "DÍA DE LA SEMANA" Range("L2").Select ActiveCell.FormulaR1C1 = "=WEEKDAY(RC[-3],11)" Range("L2").Select Selection.AutoFill Destination:=Range("L2:L631256") Range("L2:L631256").Select Range("M1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ActiveCell.FormulaR1C1 = "HORA" Range("M2").Select ActiveCell.FormulaR1C1 = "=HOUR(RC[-3])" Range("M2").Select Selection.AutoFill Destination:=Range("M2:M631256") Range("M2:M631256").Select ActiveWindow.SmallScroll Down:=-15 Range("K2:M2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy ActiveWindow.SmallScroll Down:=-60 ActiveWindow.ScrollRow = 631224 ActiveWindow.ScrollRow = 211054 ActiveWindow.ScrollRow = 122954 ActiveWindow.ScrollRow = 3874 ActiveWindow.ScrollRow = 2 ActiveWindow.SmallScroll Down:=-6 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub

Que tal, les cuento mi problema: Tengo una macro que envia correos a una columna determinada, gracias a la ayuda de los chicos del foro al agregarle la funcion "specialcells(2) inclusive puedo enviar correo aunque no esten todas las celdas completas... ( ejemplo en el archivo"FUNCIONA BIEN SIN CONDICIONAL") Agrege una hoja al archivo ("datos ")para hacer una condicion en la que si el estado del usuario es VENCIDO, figure un email en esa columna,sino " "... y ahora me sale un mensaje de error 1004 "NO SE ENCONTRARON CELDAS" al apretar el boton en la pestaña CORREO. adjunto los dos archivos el que anda bienj sin condicional y el que estoy teniendo problemas, yo necesitaria que figuren solo los datos de la gente que aparece como VENCIDO en la hoja DATOS, y que la macro me lo pueda enviar aunque haya celdas en blanco en esa columna , por que pasa esto? claramente el problema surgio al agregarle la condicion pero no se porq. Gracias y saludos CON CONDICIONAL.xlsm FUNCIONA BIEN SIN CONDICONAL.xlsm

Hola a todos, por favor si alguien me puede ayudar con lo siguiente: Tengo un reporte de varias boletas de pago, cada boleta tiene un número de DNI Necesito que en base al criterio de la celda número de DNI (celda color verde), de la hoja “BOLETAS”, haga una búsqueda en la hoja1 Columna “A” y si coincide con el número de DNI de cada boleta, que copie el cargo (columna C) que le corresponde y la ubique debajo de la celda Cargo (celda color rojo) de la hoja “BOLETAS”. De la misma forma con los datos de la columna D de la hoja1, se hace una búsqueda en base al número de DNI y de coincidir con lo asignado en cada boleta de la hoja “BOLETAS”, se debe copiar los datos de la columna D de la hoja1 en la celda de color naranja de la hoja BOLETAS”, de la misma forma para todas las boletas. Y en la celda FG (de color azul) debe decir “Sueldo y/o Jornal”, de la misma forma para las demás boletas. Adjunto archivo con las respectivas casillas comentadas y con formula, para que se entienda mejor que es lo que se desea. Muchas gracias Libro2.xlsx

Saludos nuevamente compañeros,en esta oportunidad requiero de su añuda,ya que no doy con la solución por mucho que quise,lo que busco es buscar unos códigos viejos y reemplazarlos por unos nuevos,tengo una hoja llamada "códigos nuevos" donde en la columna "A" están los códigos viejos y en la "B" los nuevos, hice un bucle para que buscara los códigos viejos en la hoja "código viejo " y los sustituyera por los códigos nuevos de la columna "B" pero no encuentra coincidencia y no hace las sustitución,si pueden sacar algo de su tiempo para ver que puede estar mal se los agradezco,adicional a esto hay un código vba que pretende extraer de una cadena de texto los números,y eso hace(el código lo encontré en la web)pero yo quiero que cuando encuentre los 2 primeros números los coloque en la columna peso y cuando encuentre los últimos 2 los coloque en la columna medida,es engorroso para mi nivel de vba sorry por eso,si no causo molestia alguno espero su valioso aporte CODIGOS NUEVOS.xlsm

Hola, tengo un código (sacado de foros de Internet) para comparar dos celdas, el caso es que funciona en principio. pero hay dos fallos, donde pone: Range("S3") = resultado1 + 1 debería (de ser igual) un 1 y me pone 2 otro fallo: de entrada ya me ejecuta la macro y me da ese resultado pero yo al entrar el valor o nombre de la segunda celda a comparar ya no hace nada me imagino que es porque ya está ejecutada, debo poner algo para que espere que entre datos de segunda celda a comparar ? Mando el código que tengo y muchas gracias. Sub macro2() Range("J8").Value = "Anselmo" Range("J14").Value = "Nombre de la primera persona" '<<<Celda J16 pendiente de entrar valor>>> Application.ScreenUpdating = False Application.EnableEvents = False Dim Str1 As String Dim Str2 As String Dim resultado1 As Long Str1 = Range("J8") Str2 = Range("J16") resultado1 = StrComp(Str1, Str2, vbTextCompare) Range("S3") = resultado1 + 1 Sheets("Hoja1").Select Application.ScreenUpdating = True Range("A1").Select Application.EnableEvents = True End Sub

Buenas tardes, gusto saludarles. Primero que nada comentarles que tengo toda la mañana investigando y recurro a ustedes en última instancia. Tengo el siguiente código: Private Sub lbl_aceptar_Click() If ActiveCell.Address = "$E$115" Then If check_box_1.Value = True Then Hoja1.Range("$E$115").Value = check_box_1.Caption ElseIf check_box_2.Value = True Then Hoja1.Range("$E$115").Value = check_box_2.Caption ElseIf check_box_3.Value = True Then Hoja1.Range("$E$115").Value = check_box_3.Caption End If End If If ActiveCell.Address = "$I$115" Then If check_box_1.Value = True Then Hoja1.Range("$I$115").Value = check_box_1.Caption ElseIf check_box_2.Value = True Then Hoja1.Range("$I$115").Value = check_box_2.Caption ElseIf check_box_3.Value = True Then Hoja1.Range("$I$115").Value = check_box_3.Caption End If End If End Sub Funciona muy bien, pero, me gustaría poder resumirlo y/o hacerlo "dinámico" con algo parecido a esto: Private Sub lbl_aceptar_Click() ActiveCell.Value = MSForms.CheckBox.Checked.Caption End Sub Es decir, que la celda activa, tome como valor el caption del CheckBox seleccionado. Pero no me funciona; lo he intentado de varias maneras, pero no lo logro. Creo que lo que necesito, salvo mejor criterio, es saber cuál de los checkBox fue seleccionado por el usuario. Quiero hacerlo general, para no tener que estar dando el nombre del CheckBox ni de la celda activa. El formulario tiene varios CheckBox. Les agradezco su ayuda.

Buenas, estoy teniendo problemas para poder enviar un correo preredactado a toda la columna, en esta caso la "D"solo se envia a la direccion de la celda D4, quisiera saber que estoy haciendo mal. Desde yamuchas gracias. adjunto archivo y codigo de la macro Sub EnviarEmail() ' ' 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 ' For Each cell In Range("d4:d302") ' 'Asignamos valor a las variables ' Asunto = "Aviso de vencimiento" Destinatario = [A11] 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 = Destinatario ' Set MItem = OutlookApp.CreateItem(olMailItem) With MItem .To = Range("d4:d302") .Subject = Asunto .Body = Join([transpose(b4:b14)], vbCrLf) .Send ' End With ' Next ' Set MItem = Nothing End Sub prob mail.xlsm

Hola! Amigos, Actualmente tengo un excel con un macro que encontré en internet para el envio de correo de una hoja de excel, pero el Outlook, versIón 2016 me muestra una moesto mensaje: "Un programa está intentando enviar correo en su nombre" revisando en la web he intentado lo siguiente sin éxito: Puede cambiar la configuración seleccionando Herramientas | Opciones | Otros | Opciones avanzadas y marcando la casilla Permitir script en carpetas compartidas. Verá que también hay una opción para Permitir script en carpetas públicas. En Outlook 2007, estas configuraciones están en Herramientas | Cuadro de diálogo Centro de confianza, bajo Seguridad de correo electrónico El autor de la macreo es Dante en todoexpertos: Application.DisplayAlerts = False ' 'Se estable cuál hoja se va a guardar en PDF Set h2 = Sheets("Extras") ' 'Ruta donde se va a guardar el archivo PDF, 'en la misma carpeta donde tienes el archivo con la macro wpath = ThisWorkbook.Path & "\" ' 'el nombre del archivo será el mismo que tiene hoja nombre = h2.Name ' 'Se genera el archivo PDF h2.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=wpath & nombre & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False ' 'Se envía el archivo por outlook Set dam = CreateObject("outlook.application").createitem(0) dam.to = Hoja11.Range("B5").Value 'Destinatario dam.body = "Estimado usuario adjunto encontrará el detalle del registro de horas extras reportadas, este correo es generado en forma automática se le ruega no responder." dam.Subject = "Notificación Automática " & " " & Range("j4") '"Asunto" dam.Attachments.Add wpath & nombre & ".pdf" dam.Send Agradezco me puedan ayudar para quitar este molesto mensaje: Mis disculpas si el tema no va en la categoría.