isidrod

@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/

checa este link Luis Antonio https://excelsignum.com/2016/02/15/importar-archivos-txt-delimitados-por-caracteres/ saludos isidro

Sub Macro3() If Range("A1").Value = "" Then 'valida que haya texto en la celda "A1" para que pueda realizarlo. Range("A1").FormulaR1C1 = "=+RC[1]" End If With Worksheets("Hoja1").Range("A2:A" & Range("B65536").End(xlUp).Row) .FormulaR1C1 = "=IF(LEFT(RC[1],1)=""T"",RC[1],R[-1]C)" .Value = .Value End With End Sub así funciono en mi equipo

no se que es lo quieres hacer, con lo que te pase ya quedo. solucionado?