isidrod

@davidgorros12 buen día te dejo este a ver si te funciona y es lo que buscas saludo isidro

@howling buen día un favor no escribas tus mensajes en mayúsculas, porque eso quiere decir que estas gritando gracias que tengas un excelente dia saludos isidro

bueno usando la macro de @Leopoldo Blancas y otra que agregue el e modulo 2, para ver si es lo que quieres @MAURO_1512 es todo lo que pude hacer saludos isidro ejemplolote.xlsm

@Luis paz ya probé tu macros y si meda el mismo error pero manual si cargan no los reconoce cuando las macro los carga esos archivo a ver si @avalencia @Leopoldo Blancas @Snake que nos dice saludos isidro

bueno ahí te dejo el mio a ver si te funciona =SI(CONTAR.SI.CONJUNTO($B$6:$B$11,B6)=1,C6*0.3,"")

gracias @Haplox por tus sabios consejos

gracias @Haplox por tu punto de vista lo tomaremos en cuenta para no usar ese control de errores y buscaremos una solución como la de @Antoni o como todos los maestros que aquí comparte su sabiduría saludos isidro

@manzano ejecute el código con dos archivo así y me funciono Sub TEST() ' ' TEST Macro Dim wbDestino As Workbook, _ wsOrigen As Excel.Worksheet, _ wsDestino As Excel.Worksheet, _ rngOrigen As Excel.Range, _ rngDestino As Excel.Range Sheets("DATA").Select Range("A1").Select On Error Resume Next Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "/1", Local:=True) Set wsDestino = wbDestino.Worksheets("1") Set wsOrigen = Worksheets("1") Const celdaOrigen = "A1" Const celdaDestino = "A1" Set rngOrigen = wsOrigen.Range(celdaOrigen) Set rngDestino = wsDestino.Range(celdaDestino) rngOrigen.Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy ThisWorkbook.Activate ActiveSheet.Paste Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select wbDestino.Close primero: 'SEGUNDO ARCHIVO' 'On Error GoTo segundo Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "/2", Local:=True) Set wsDestino = wbDestino.Worksheets("2") Set wsOrigen = Worksheets("2") Set rngOrigen = wsOrigen.Range(celdaOrigen) Set rngDestino = wsDestino.Range(celdaDestino) rngOrigen.Select ActiveCell.Offset(1, 0).Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy ThisWorkbook.Activate ActiveSheet.Paste Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select wbDestino.Close segundo: 'TERCER ARCHIVO' 'On Error GoTo tercero Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "/3", Local:=True) Set wsDestino = wbDestino.Worksheets("3") Set wsOrigen = Worksheets("3") Set rngOrigen = wsOrigen.Range(celdaOrigen) Set rngDestino = wsDestino.Range(celdaDestino) rngOrigen.Select ActiveCell.Offset(1, 0).Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy ThisWorkbook.Activate ActiveSheet.Paste Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select wbDestino.Close Application.CutCopyMode = False tercero: End Sub solo me manda este mensaje saludos isidro

@juan Ignacio que bueno que ya se soluciono, @Leopoldo Blancas solo queda con macros para para que el archivo sea menos pesado y gracias @GabrielRaigosa por llegar con tus formulas al rescate y PQ saludos isidrod

@Leopoldo Blancasme atreví a hacerlo con formula y envió mi pequeño ejemplo a ver si es así juan ignacio saludos isidro FL.xlsm

buen día @CHEWACA a ver si te funciona este código 'https://www.extendoffice.com/es/documents/excel/2328-excel-open-multiple-hyperlinks.html Sub OpenHyperLinks() 'Update 20141124 Dim xHyperlink As Hyperlink Dim WorkRng As Range On Error Resume Next xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection 'Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) Set WorkRng = Range("G3:G" & Range("A65536").End(xlUp).Row) For Each xHyperlink In WorkRng.Hyperlinks xHyperlink.Follow Next End Sub saludos isidro

Sub quitar_letras() Dim lColumn As Long Application.ScreenUpdating = False With Worksheets("Hoja2").Range("A2:iv" & Cells(Rows.Count, "iv").End(xlUp).Column) .Replace What:="h", Replacement:="" End With Application.ScreenUpdating = True End Sub esta otra solución saludos

a ver si con este te funciona @alistair Sub quitar_letras() Application.ScreenUpdating = False With Worksheets("Hoja1").Range("D4:K" & Range("D65536").End(xlUp).Row) .Replace What:="h", Replacement:="" End With Application.ScreenUpdating = True End Sub en mi equipo funciono saludos isidro

buen día @ROVER1965 yo lo haría así sencillo con este tipo de formula y con mi poco conocimiento que tengo, pero los experto en excel puede hacerlo mas brillante que apoyan en este foro ejemplo control de revistas.xlsx

checa estos https://excelyvba.com/macro-para-copiar-y-pegar-celdas-en-excel/ https://www.todoexpertos.com/preguntas/5ka43xsgjoxfherf/copiar-celdas-de-una-hoja-a-otra-segun-un-criterio

buen día @eugeniocol sube un archivo de ejemplo por favor para alguien mas pueda ayudarte saludos isidro

Sub copiar() With Worksheets("hoja1").Range("L2:R" & Range("L2").End(xlDown).Row).ClearContents End With Application.ScreenUpdating = False 'inicializo la variable j J = 2 'comienzo el bucle For i = 2 To Range("A65536").End(xlUp).Row 'compruebo que el valor sea mayor que 0 If Cells(i, "R").Value = 0 Then 'copio la fila entera y la pego Range(Cells(i, "L"), Cells(i, "R")).Copy Destination:=Sheets("hoja1").Cells(J, "A") 'aumento la variable j para que vaya a la siguiente fila de la hoja filtros 'cuando encuentre una nueva fila que cumple con la condición de mayor que cero J = J + 1 End If Next End With Application.ScreenUpdating = True End Sub te dejo ese código a ver si te funciona solo modifica tus nombres de tus hojas saludos

este otro link https://ayudaexcel.com/foro/topic/27567-reproducir-mp3/?_fromLogin=1 saludos isidro

@Juan Pelfort te dejo este link si es lo que quieres http://www.exceleinfo.com/reproducir-archivos-de-audio-en-excel-vba-con-control-de-windows-media-player/ https://www.extendoffice.com/es/documents/excel/4483-excel-play-video.html saludos isidro reproducir video.xlsm

@Juan Pelfort te dejo este link si es lo que quieres http://www.exceleinfo.com/reproducir-archivos-de-audio-en-excel-vba-con-control-de-windows-media-player/ saludos isidro

eres un genio Antoni saludos isidro

'https://www.extendoffice.com/es/documents/excel/3231-excel-import-multiple-text-files-to-multiple-sheets.html Sub CombineTextFiles() 'updateby Extendoffice 20151015 Dim xFilesToOpen As Variant Dim I As Integer Dim xWb As Workbook Dim xTempWb As Workbook Dim xDelimiter As String Dim xScreen As Boolean On Error GoTo ErrHandler xScreen = Application.ScreenUpdating Application.ScreenUpdating = False 'xDelimiter = "|" xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Kutools for Excel", , True) If TypeName(xFilesToOpen) = "Boolean" Then MsgBox "No files were selected", , "Kutools for Excel" GoTo ExitHandler End If I = 1 Set xTempWb = Workbooks.Open(xFilesToOpen(I)) xTempWb.Sheets(1).Copy Set xWb = Application.ActiveWorkbook xTempWb.Close False xWb.Worksheets(I).Columns("A:A").TextToColumns _ Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Tab:=False, Semicolon:=False, _ Comma:=False, Space:=False, _ Other:=True, OtherChar:="|" Do While I < UBound(xFilesToOpen) I = I + 1 Set xTempWb = Workbooks.Open(xFilesToOpen(I)) With xWb xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count) .Worksheets(I).Columns("A:A").TextToColumns _ Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Tab:=False, Semicolon:=False, _ Comma:=False, Space:=False, _ Other:=True, OtherChar:=xDelimiter End With Loop ExitHandler: Application.ScreenUpdating = xScreen Set xWb = Nothing Set xTempWb = Nothing Exit Sub ErrHandler: MsgBox Err.Description, , "Kutools for Excel" Resume ExitHandler End Sub checa eso a ver si e lo quieres es todo lo que pude hacer por ti a ver alguien mas puede apoyarte saludos isidro

checa este otro link https://www.extendoffice.com/es/documents/excel/456-combine-multiple-workbooks.html

estos link https://www.rondebruin.nl/win/addins/rdbmerge.htm https://www.excelnegocios.com/macro-para-unir-varios-libros-excel-en-una-sola-hoja/ aver si te funcionan saludos isidro

este otro link https://ayudaexcel.com/foro/topic/38226-importar-ficheros-txt-a-hojas/