Jump to content
  • Debido a la crisis sanitaria, hasta el día 31 de marzo, el registro al foro de Ayuda Excel será totalmente gratuito para facilitar el teletrabajo. Todos los registros que se produzcan entre estas fechas tendrán acceso gratuito ilimitado a la comunidad hasta el 30 de abril.

    Regístrate

    Si te surge alguna duda mientras estás trabajando en casa con Excel, ya tienes a quien preguntar.

    Espero que esta medida te sirva de ayuda. Frenar la expansión del coronavirus depende de todos. Sé responsable.

Recommended Posts

Buenos días a los integrantes de este foro, en esta ocasión recurro a uds, para que brinde su apoyo en como mejorar la siguiente macro, lo que requiero es que me permita seleccionar la ruta donde se encuentra el archivo a utilizar, ya que esta macro ejecuta todos los archivos que se encuentran en dicha carpeta (previamente haber copiado todos los archivos a una carpeta determinada) y lo otro sería que si solo mostrara los archivos que empiecen con el nombre CONSOLIDADO xxxxxxxx.xlsm o CONSOLIDADO xxxxxxxx.xlsx, para lo cual adjunto archivos como ejemplos.

archivo principal: MUESTRA FORMULARIO.xlsm

Private Sub CommandButton2_Click()
    Dim ruta As String
    Dim fichero As String
    Dim wbOrigen As Workbook
    Dim uFO, uFD, uFF As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    
    Set wbOrigen = ThisWorkbook
    
    ruta = ThisWorkbook.Path & "\"
    
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            fichero = ruta & ListBox1.List(i)
            Workbooks.Open (fichero)
            Sheets("PLANILLA").Activate
            uFO = Range("A" & Rows.Count).End(xlUp).Row
            uFD = wbOrigen.Sheets("PLANILLA").Range("C" & Rows.Count).End(xlUp).Row + 1
            
            Range("B8:BE" & uFO).Copy wbOrigen.Sheets("PLANILLA").Range("B" & uFD)
            ActiveWorkbook.Close (False)
            
        End If
    Next i
    
    Range("B8:BE8").Borders.LineStyle = xlContinuous
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
    
    MsgBox "PROCESO TERMINADO"
    
End Sub

Dede ya agradezco su apoyo y coloración.

 

MUESTRA FORMULARIO.xlsm CONSOLIDADO CORDILLERA 24-7-2019 11-20-10 HRS.xlsx CONSOLIDADO ELITE FAITH 24-7-2019 16-45-53 HRS.xlsx

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png