Jump to content

Sebastianss

Members
  • Content Count

    20
  • Joined

  • Last visited

About Sebastianss

  • Rank
    Member
  • Birthday 07/15/1954

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. Gerson. Muchas gracias por la ayuda. Aun no. Busco que cada vez que corre el código, facilitado por Macro Antonio, que en el Libro que abre inserte las hojas Hoja2 y Hoja1. Otra posibilidad es que el Código corra en el archivo Imp01 que ya tien esas hojas. Agradezco la ayuda con este pienso último detalle. Saludos Private Sub CrearUnLibroConVarios() Dim FSO As Object, Carpeta As Object, Archivo As Object, nuevo As Worksheet Application.ScreenUpdating = False Set FSO = CreateObject("Scripting.FileSystemObject") Set Carpeta = FSO.GetFolder("D:\DTK\dtkfrms\") Workbooks.Add Set nuevo = ActiveWorkbook.ActiveSheet For Each Archivo In Carpeta.Files Workbooks.Open Archivo ActiveSheet.UsedRange.Copy _ nuevo.Range("A" & nuevo.Range("A" & Rows.Count).End(xlUp).Row) ActiveWorkbook.Close
  2. Muchas gracias. En cuanto termine de escribir el código vba que necesito, estudiaré el PQ. Por el momento acabo de solicitar al foro, lo que a mi entender, es la ultima instrucción que busco para terminar mi código. Muchas gracias por su amabilidad.
  3. Hola Amigos Investigando en la Web y con la primera ayuda de este foro finalmente logré escribir el código (que necesito) dentro de un Loop While. Sin embargo, no he podido escribir despés de Application.CutCopyMode = False, la instrucción que cierre el primer libro y siguientes que abrirá el Loop cada vez que corre el Código. Abajo incluyo las primeras líneas del Código. En la Con la instrucción termino el Código que he estado escribiendo. Una vez que lo pruebe, lo compartiré en el Foro Agradezco la ayuda. Sub importador() Dim myfolder As String, myfile As String Dim destination As Worksheet 'destination = ThisWorkbook.Sheets("Sheet1") Set destination = Sheet1 myfolder = "D:\ABC\data" myfile = Dir(myfolder & "\*xl*") Do While myfile <> "" Workbooks.Open Filename:=myfolder & "\" & myfile 'Abre el primer archivo xls Range("A1:DS2").Select Selection.Copy Application.Left = 721.75 Application.Top = 61.75 Windows("importador.xlsm").Activate ‘Este es el libro que corre el código. ¿Hay otra instrucción para llamarlo? ActiveSheet.Paste Range("A1").Select Application.CutCopyMode = False 'Aquí necesito una instrucción para cerrar cada libro Excel que abre el loop Sheets(Hoja1).Select . . . . . End Loop End Sub
  4. Gerson. Muchas gracias. Voy a abrir los enlaces para analizar lo que sugieres. Saludos
  5. Muchas gracias. Funciona. El mensaje no se despliega. Sigo trabando como colocar todo el Código en un Ciclo. Saludos
  6. Estimado Macro Antonio Me disculpo por el atraso en la respuesta, el impacto negativo del Huracán Otto y una afectación en la salud, me mantuvieron fuera de la práctica que estoy desarrollando. Con el código que incluyo, le he agregado al inicio un código para abrir un Archivo Excel desde una Carpeta que almacena más de 180 archivos. Lo que estoy buscando es que al abrir el Archivo Importdtk1 que tendré un botón vba haga lo siguiente: 1. Ir a la Carpeta D:\DTK\dtkfrms y abrir un archivo Excel cuyo ejemplo se incluye en el código. 2. Correr el Código hasta el Final 3. Copiar el currenteregion y pegarlo archivo Excel de la Ruta en D:\DTK\tblsdtk 4. Ir a la Carpeta D:\DTK\dtkfrms y abrir otro archivo Excel correr el Código, pero, a partir de aquí debe copiar el archivo y pegarlo en D:\DTK\tblsdtk en la línea siguiente al pegado anterior. 5. Repetir el código hasta que no haya archivos en D:\DTK\dtkfrms. Nota. Como el archivo como el archivo en D:\DTK\tblsdtk está abierto necesito, como hago para evitar que me un mensaje me indique que ya está abierto. Cada vez que corro el Código, en la línea 13 AcitveWindows.Close necesito eliminar el mensaje: “Se ha puesto gran cantidad de Información en el portapapeles. Desea que esta información quede disponible para pegarla en otro documento…..” El Código que me diste no he podido ponerlo en ejecución Agradezco de antemano la ayuda que me puedan ofrecer 1 Sub importdtk() 2 ChDir "D:\DTK\dtkfrms" 3 Workbooks.Open Filename:="D:\DTK\dtkfrms\01_11_2016_AU1.xlsx" 4 Range("A1:A2").Select 5 Range(Selection, Selection.End(xlToRight)).Select 6 Selection.Copy 7 Windows("importdtk1.xlsm").Activate 8 Range("A1").Select 9 ActiveSheet.Paste 10 Application.Left = 37 11 Application.Top = 121.75 12 Windows("01_11_2016_AU1.xlsx").Activate 13 ActiveWindow.Close 14 Range("A1").Select 15 16 Range("A1").Select 17 Sheets("Hoja1").Select 18 Range("J2").Select 19 Range("J2:CX2").Select 20 Application.CutCopyMode = False 21 Selection.Copy 22 23 Sheets("Hoja2").Select 24 Range("A2").Select 25 Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 26 False, Transpose:=True 27 28 With ActiveSheet 29 On Error Resume Next 30 .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).SpecialCells(4).EntireRow.Delete 31 On Error GoTo 0 32 End With 33 34 Sheets("Hoja1").Select 35 Range("D2").Select 36 Selection.Copy 37 Sheets("Hoja2").Select 38 Range("B2").Select 39 ActiveSheet.Paste 40 Sheets("Hoja1").Select 41 Range("G2").Select 42 Application.CutCopyMode = False 43 Selection.Copy 44 Sheets("Hoja2").Select 45 Range("C2").Select 46 ActiveSheet.Paste 47 Range("D2").Select 48 49 Sheets("Hoja1").Select 50 Range("H2").Select 51 Application.CutCopyMode = False 52 Selection.Copy 53 Sheets("Hoja2").Select 54 Range("D2").Select 55 ActiveSheet.Paste 56 57 ActiveSheet.Paste 58 Range("E2").Select 59 Range("E2").Value = 1 60 Range("E2").Select 61 Range(Selection, Selection.End(xlDown)).Select 62 With Selection 63 .HorizontalAlignment = xlCenter 64 .VerticalAlignment = xlBottom 65 .WrapText = False 66 .Orientation = 0 67 .AddIndent = False 68 .IndentLevel = 0 69 .ShrinkToFit = False 70 .ReadingOrder = xlContext 71 .MergeCells = False 72 End With 73 74 Sheets("Hoja1").Select 75 Range("DO2:DP2").Select 76 Selection.Copy 77 Sheets("Hoja2").Select 78 Range("F2").Select 79 ActiveSheet.Paste 80 81 Sheets("Hoja1").Select 82 Range("E2").Select 83 Selection.Copy 84 Sheets("Hoja2").Select 85 Range("H2").Select 86 ActiveSheet.Paste 87 88 Range("A2").Select 89 Selection.End(xlDown).Select 90 Range("B23").Select 91 ActiveCell.FormulaR1C1 = "hola" 92 Range("B2:H2").Select 93 Selection.Copy 94 Range(Selection, Selection.End(xlDown)).Select 95 ActiveSheet.Paste 96 97 Hoja2.Columns.AutoFit 98 Application.CutCopyMode = False 99 Application.ScreenUpdating = True 100 101 Range("A2:H2").Select 102 Range(Selection, Selection.End(xlDown)).Select 103 Selection.Copy 104 Workbooks.Open Filename:="D:\DTK\tblsdtk\tblsdtk.xlsx" 105 Range("A2").Select 106 ActiveSheet.Paste 107 Range("A2").Select 108 Windows("importdtk1.xlsm").Activate 109 Range("A2").Select 110 Application.CutCopyMode = False 111 112 End Sub
  7. Macro Antonio. Muchas gracias. Voy a probarlo y te aviso.
  8. Hola amigos El 16/11/2016, pedí ayuda a este foro para codificar un procedimiento. Paralelamente, me di a la tarea de investigar para poco a poco ir escribiendo dicho código. A la fecha logré lo que buscaba con el código que abajo incluyo. No obstante, me gustaría saber si a ese código se le puede mejorar la eficiencia. Como pueden ver no hay variables declaradas, no encontré como hacerlo. Finalmente, necesito escribir un bucle (lo he intentado sin éxito) que abarque el código para que haga lo siguiente: 1. Abrir de una carpeta un archivo excel y ejecute el código (cada archivo esta identificado por fecha:dd-mm-yyyy). 2. Copiar la currentregion y pegarla en la hoja1 de otro libro excel 3. Abrir otro archivo excel correr el código 4. Copiar la currentregion y pegarla debajo de la última línea del paso 2. 5. Seguir con el procedimiento hasta que no haya libros en la carpeta Sub importdtkfrm() Workbooks.Open Filename:="D:\AZK\Dtk\DtkFrms\13_11-2016.xlsx" Windows("imprtdtk.xlsx").Activate Application.WindowState = xlNormal Windows("13_11-2016.xlsx").Activate Sheets.Add After:=ActiveSheet Application.WindowState = xlNormal Windows("imprtdtk.xlsx").Activate Sheets("Hoja1").Select Range("D2").Select Selection.Copy Sheets("Hoja2").Select Range("B2").Select ActiveSheet.Paste Range("E2").Select Range("E2").Value = 1 Sheets("Hoja1").Select Range("G2").Select Selection.Copy Sheets("Hoja2").Select Range("C2").Select ActiveSheet.Paste Sheets("Hoja1").Select Range("H2").Select Selection.Copy Sheets("Hoja2").Select Range("D2").Select ActiveSheet.Paste Sheets("Hoja1").Select Range("J2").Select Range("J2:CX2").Select Application.CutCopyMode = False Selection.Copy Sheets("Hoja2").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, transpose:=True Sheets("Hoja1").Select Range("DO2:DP2").Select Application.CutCopyMode = False Selection.Copy Sheets("Hoja2").Select Range("F2").Select ActiveSheet.Paste Sheets("Hoja1").Select Range("E4").Select Application.CutCopyMode = False Selection.Copy Sheets("Hoja2").Select Range("H2").Select ActiveSheet.Paste Hoja2.Columns.AutoFit Application.CutCopyMode = False Application.ScreenUpdating = True With ActiveSheet On Error Resume Next .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).SpecialCells(4).EntireRow.Delete On Error GoTo 0 End With Range("A2").Select Selection.End(xlDown).Select ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "hola" 'escribí hola para poder seleccionar el rango Selection.End(xlUp).Select Range(Selection, Selection.End(xlToRight)).Select Selection.Copy Range(Selection, Selection.End(xlDown)).Select ActiveSheet.Paste Range("A2").Select Range("B1").Select Range("A1").Select Selection.CurrentRegion.Select Selection.Cut Workbooks.Open Filename:="D:\AZK\Dtk\DtkFrms\Imp\imptbl.xlsx" Range("A2").Select ActiveSheet.Paste 'acá para el segundo archivo que correl el código, necesito que pegue lo copiado seguido de la última línea con datos del primer pegado. Windows("DatosFormulario13-11-2016.xlsm").Activate Range("E2").Select Range(Selection, Selection.End(xlDown)).HorizontalAlignment = xlCenter Cells.EntireColumn.AutoFit Application.CutCopyMode = False End Sub Agradezco la ayuda
  9. Hola Amigos Estoy recibiendo libros de Excel 2013 donde la Hoja 1 tiene columnas, La columna columna B tiene n celdas con registros. Cada vez que abro un libro de cada columna debo copiar manualmente hacia abajo los datos que tiene en la celda 2 hasta el último registro de la columna B En los archivos 12_11_2016 y 13_11_2016 en la Hoja 1 se indica como recibo los libros y en la hoja 2 de cada libro como los necesito En la Hoja1 del libro Importar se ilustra como se deben ir copiando los registros. Desde el libro Importar que está en el escritorio, necesito correr mediante un Botón de Comando un código en vba que haga lo descrito. Los libros Excel que recibo a diario están en la carpeta llamada DTK en D:DTK Agradezco la ayuda con la petición del Código en VBA. Saludos 12_11_2016.xlsx 13_11_2016.xlsx importar.xlsx
  10. DUDA. Adjunto Código. Tengo casi tres semanas de trabajar en este proyecto para aprender. El usuario al digita el primer valor en C2, entonces A2 muestra la fecha de Hoy. Luego digita un valor en B2, este valor solo se escribe una vez al ingresar el primer dato en C2. Luego el usuario digita un valor en E2 y da clic a botón Run que calcula valores en D2 y F2, pero, muestra en B3 muestra el valor de B2 + 1, que no debe ocurrir. El botón Run, también, debe mostrar en la fila 5 (no en la 4) los totales de las columnas C,D,E y F. Así, cada ves que se digita un valor en C la fila con los totales se va incrementado en 1 hacia abajo. La Fila de Totales también debe mostar la fecha de hoy, como se indica en la Hoja2. La idea es que E2 se vaya incrementando en 1 cada vez que da clic al botón run, sin embargo, eso no ocurre. La Hoja1 muestra lo que ocurre al digitar en Rango C dos valores (5000 y 8250). En Hoja2 se muestra lo que el código debe hacer. He dedicado muchas horas a tratar de solucionar este inconveniente, incluso, con manuales, forum, Youtube y tampoco no he podido encontrado alguna pista. Adjunto archivo excel Agradezco la ayuda que me puedan dar. Saludos Private Sub cmbRun_Click() Dim i As Integer Dim lngRC As Long Const clngSTART As Long = 2500 i = 2 Application.EnableEvents = False Do While Cells(i, 3).Value > 0 Cells(i, 4).Value = (Cells(i, 3).Value * 0.13) Cells(i, 6).Value = Cells(i, 3).Value + Cells(i, 4).Value + Cells(i, 5).Value i = i + 1 Loop Dim LastRow As Long LastRow = Range("C" & Rows.Count).End(xlUp).Row Range("D2:D" & LastRow).Formula = "=C2*0.13" Range("F2:F" & LastRow).Formula = "=SUM(C2:E2)" ' Agrega totales en linea 4 Range("C" & LastRow + 2 & ":F" & LastRow + 2).FormulaR1C1 = "=SUM(R2C:R[-2]C)" With Range("B2") If .Value = "" Then .Value = clngSTART End With For lngRC = 3 To Range("C" & Rows.Count).End(xlUp).Row 'En fila 3 Suma 1 a B2. En celda 4 suma 1 al valor anterior Esta instrucción debe correr solo al digitar un registro en el Range C Cells(lngRC, "B").Value = Cells(lngRC - 1, "B").Value + 1 Next lngRC Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 3 Then Cells(Target.Row, 1) = Now() End Sub [/CODE] LFFC_Test3.zip
  11. Funciona correctamente. Muchas gracias. Por último, aunque no relevante, no pude ver en Modo de Diseño el Botón Consolidado. Consulta Solucionada Satisfactoriamente
  12. Hola Armando. La instrucción [A2:A57] = ActiveSheet.Name [b2:B57] = 2014 En el Campo Nombre escribe Consolidado. Lo que necesito es que en el Campo Nombre escriba el nombre de la Hoja que originó los datos. Por otra parte, esa instrucción solo copia hasta la celda 57. Originalmente cada Hoja tiene un nombre, pero, los campos Año y Nombre están vacíos. Entonces como primer paso, un código debe, en cada hoja, copiar el nombre y pegarlo en el campo Nombre y en el Campo Año escribir 2014, hasta la última fila con datos (instrucción para los dos campos). Voy a buscar y a estudiar los manuales que recomiendas. Muchas gracias por tu amable y valiosa ayuda. Saludos
  13. Hola Don Armando. El Código funciona excelente. Sin embargo, originalmente, como indiqué en mi primer mensaje, en cada Hoja <> a Consolidado los campos Nombre y Año no tienen registros. Por ello, una instrucción debe copiar el Nombre de cada Hoja y pegarlo en el campo Nombre. Además, en el campo Año, escribir 2104 . Como prueba en el Rango ("A1") de cada Hoja escribí su nombre y luego di click en la esquina inferior derecha, accion que copió el nombre hacia abajo. En el archivo adjunto, los campos Nombre y año no tienen registros. Me parece (ignoro si es un For dentro de un IF, o un If dentro de un For, o un While) que esas dos acciones (desconozco la sintaxis y dónde colocarlas,) pueden incluir: Range("B" &????).Value= WorkSheet.Name Range("C" &????).Value= 2014. Lo anterior, lo intuyo basado en decenas de ejemplos que he investigado en este Foro. También, desconozco si se debe hacer en dos procedimientos. Finalmente correr el código que recomiendas. Sub Consolidado() Application.ScreenUpdating = False For Each Sheet In ThisWorkbook.Worksheets If Sheet.Name <> "Consolidado" Then Sheet.Cells(Rows.Count, 1).End(xlUp).CurrentRegion. _ Offset(1).Resize(, 2).Copy Sheet1.Range("A" & Rows.Count).End(xlUp).Offset(1) Next Sheet Application.ScreenUpdating = True End Sub Muchas gracias por tu valiosa ayuda Prueba999b.zip
  14. Don Armando. Muchas gracias por su atenta y pronta respuesta. Doy mis más sinceras disculpas por dicha omisión. Adjunto archivo con lo indicado. Prueba.zip
×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png