Macro Excel para generar bucle. Ayuda
Buenas Noches.
Tengo este código:
Este código abre un libro que el nombre del libro esta dado por un listado que comienza en la hoja 2 del mismo Libro, los nombres están desde la celda B1 hasta la B5, según las semanas que contengan un mes.
Yo necesito que el valor contenido en esta línea que hace referencia a la celda B1 y ejecute el código por cada celda con datos que puede ir hasta B5.
La Línea es esta: ThisWorkbook.Sheets(2).Range("B1").Select
Este es el código.
Sub Copia_de_Datos()
Dim strArchivo As String
Dim oLibro As Workbook
Dim nombre As String
ThisWorkbook.Sheets(2).Range("B1").Select
nombre = ActiveCell.Value
carpeta = ThisWorkbook.Path
'Creamos la variable de la ruta
strArchivo = carpeta & "\" & nombre
'Comprobamos si el archivo existe en la ruta indicada
If Dir(strArchivo) = "" Then
MsgBox "No existe el archivo en la ruta indicada."
Exit Sub
End If
'Deshabilitamos la actualización de pantalla
Application.ScreenUpdating = False
'Comprobamos si el libro ya esta abierto,
'y, si no lo esta, lo abrimos
'Deshabilitamos los avisos de error
On Error Resume Next
'Intentamos asignar a la variable un libro
'abierto con el nombre que buscamos
Set oLibro = Workbooks(Dir(strArchivo))
'Habilitamos los avisos de error
On Error GoTo 0
'Si la variable no tiene nada asignado
'le asignamos el libro abriendolo directamente
If oLibro Is Nothing Then Set oLibro = Workbooks.Open(strArchivo)
'Definimos Rango de Datos
'Fila_Final = Range("A" & Cells.Rows.Count).End(xlUp).Row 'Se busca la ultima fila con datos
'Range("A2:I" & Fila_Final).Select
Fila_Final = Range("J" & Cells.Rows.Count).End(xlUp).Row
'Realizamos la copia (se supone que el libro Total Horas.xls
'estaría siempre abierto a la hora de ejecutar el código
oLibro.Worksheets(4).Range("B41:J" & Fila_Final).Copy _
ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1)
'Cerramos sin guardar cambios
oLibro.Close False
'Vaciamos la variable
Set oLibro = Nothing
'Habilitamos la actualización de pantalla
Application.ScreenUpdating = True
End Sub
1 respuesta
Respuesta de Elsa Matilde
2
Si necesitas repetir 'lo mismo' para las 5 celdas de col B así seria el bucle:
Sub Copia_de_Datos()
Dim strArchivo As String
Dim oLibro As Workbook
Dim nombre As String
For i = 1 to 5
'contemplamos que B tenga valor
If ThisWorkbook.Sheets(2).Range("B" & i) <> "" Then
ThisWorkbook.Sheets(2).Range("B" & i).Select
'..... todo tu codigo teniendo en cuenta la fila que ahora se indica con i
End If
'repetimos para la celda sgte
Next i
End SubProbalo y comentame. Si todo queda resuelto no olvides valorar y finalizar la consulta.
¡Gracias! Elsa!! Espectacular, con una pequeña modificación cuenta solo la cantidad de celdas con datos y lo carga en la secuencia "For"
Aquí comparto el código.
Sub Funcionando()
'Limpiamos el contenido de la hoja
Sheets(1).Range("A2:I1500").ClearContents
Sheets(2).Range("A1:B20").ClearContents
' Contenido_Carpeta() 'listamos el contenido de la carpeta
'Sección 1: Variables a utilizar en la macro
Dim carpeta, archivos As String
Dim contador As Integer
'Sección 2: Lectura de carpeta y ajustes necesarios
carpeta = ThisWorkbook.Path
If carpeta = "" Then
Exit Sub
ElseIf Right(carpeta, 1) <> "\" Then
carpeta = carpeta & "\"
End If
'Sección 3: Preparación de variables
contador = 1
archivos = Dir(carpeta)
'Sección 4: Recorrido de la carpeta
Do While Len(archivos) > 0
Sheets(2).Cells(contador, 1).Value = archivos 'Definimos que el listado se almacena en la hoja 2
Sheets(2).Cells(contador, 2).FormulaR1C1 = _
"=IF(ISNUMBER(FIND(""Septiembre"",RC[-1])),RC[-1],"""")" 'Pegamos Formula en columna B
archivos = Dir()
contador = contador + 1
Loop
'Borramos las lineas que no son planillas del mes
'Por.DAM TodoExpertos.com
For i = Range("B" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 2) = "" Or Cells(i, 2) = 0 Then Rows(i).Delete
Next
Dim strArchivo As String
Dim oLibro As Workbook
Dim nombre As String
'Busca la ultima fila con datos en columna B y almacena el numero en "n"
n = Range("B" & Cells.Rows.Count).End(xlUp).Row
For i = 1 To n 'Secuencia "For" By Elsa de TodoExpertos.com
'contemplamos que B tenga valor
If ThisWorkbook.Sheets(2).Range("B" & i) <> "" Then
ThisWorkbook.Sheets(2).Range("B" & i).Select
'ThisWorkbook.Sheets(2).Range("B1").Select
nombre = ActiveCell.Value
carpeta = ThisWorkbook.Path
'Creamos la variable de la ruta
strArchivo = carpeta & "\" & nombre
'Comprobamos si el archivo existe en la ruta indicada
If Dir(strArchivo) = "" Then
MsgBox "No existe el archivo en la ruta indicada."
Exit Sub
End If
'Deshabilitamos la actualización de pantalla
Application.ScreenUpdating = False
'Comprobamos si el libro ya esta abierto,
'y, si no lo esta, lo abrimos
'Deshabilitamos los avisos de error
On Error Resume Next
'Intentamos asignar a la variable un libro
'abierto con el nombre que buscamos
Set oLibro = Workbooks(Dir(strArchivo))
'Habilitamos los avisos de error
On Error GoTo 0
'Si la variable no tiene nada asignado
'le asignamos el libro abriéndolo directamente
If oLibro Is Nothing Then Set oLibro = Workbooks.Open(strArchivo)
'Realizamos la copia (se supone que el libro Total Horas.xls
'estaría siempre abierto a la hora de ejecutar el código
Fila_Final = Range("J" & Cells.Rows.Count).End(xlUp).Row 'Se busca la ultima fila con datos
Range("A2:I" & Fila_Final).Select
oLibro.Worksheets(4).Range("B41:J" & Fila_Final).Copy _
ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1)
'Cerramos sin guardar cambios
oLibro.Close False
'Vaciamos la variable
Set oLibro = Nothing
'Habilitamos la actualización de pantalla
Application.ScreenUpdating = True
End If
'repetimos para la celda siguiente
Next i
End Sub
