Jump to content

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