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