Donde colocar la siguiente línea a una macro
Ayúdame a colocar la línea que limpia celdas a la sigte macro:
Sub BuscarMatriculas()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("hoja1")
'
If h1.[A5] = "" Then
MsgBox "MARIA, FAVOR PONER LA FECHA DEL DIA"
Exit Sub
End If
'
ruta = "D:\CENTRO EDUCATIVO FE Y ESPERANZA\carpeta de factura\"
'ruta = l1.Path & "\archivos\"
arch = Dir(ruta & h1.[N5] & "*.xls*")
col = "IT"
Do While arch <> ""
If arch <> l1.Name Then
Set l2 = Workbooks.Open(ruta & arch)
Set h2 = l2.Sheets(1)
If h2.[N5] = h1.[A5] Then
u = 8
Do While h1.Cells(u, "J") <> ""
u = u + 1
Loop
h1.Cells(u, "D") = h2.[L13]
h1.Cells(u, "C") = h2.[H13]
h1.Cells(u, "B") = h2.[D13]
h1.Cells(u, "E") = h2.[D17]
h1.Cells(u, "F") = h2.[D20]
h1.Cells(u, "J") = h2.[O18]
h1.Cells(u, "I") = h2.[E7]
h1.Cells(u, "G") = h2.[L11]
h1.Cells(u, "A") = h2.[N6]
h1.Cells(u, col) = arch
End If
l2.Close False
End If
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "YA TERMINE, MARIA"
End Subla linea:
("B10:E232"). ClearContents
2 Respuestas
Respuesta de Dante Amor
1
Pero no comentas cuáles celdas quieres limpiar. Las de la hoja1 o las de las hojas de los otros libros.
Si vas a limpiar las celdas destino, es decir, las de la hoja1, deberías limpiar desde la celda A8 hasta la J & última fila.
Entonces sería así:
Sub BuscarMatriculas()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("hoja1")
'
If h1.[A5] = "" Then
MsgBox "MARIA, FAVOR PONER LA FECHA DEL DIA"
Exit Sub
End If
'
ruta = "D:\CENTRO EDUCATIVO FE Y ESPERANZA\carpeta de factura\"
'ruta = l1.Path & "\archivos\"
arch = Dir(ruta & h1.[N5] & "*.xls*")
col = "IT"
'
uf = h1.range("J" & rows.count).end(xlup).row
if uf < 8 then uf = 8
h1.Range("A8:J" & uf).ClearContents 'aquí va la línea h1.range("B10:E232").clearcontents
'
Do While arch <> ""
If arch <> l1.Name Then
Set l2 = Workbooks.Open(ruta & arch)
Set h2 = l2.Sheets(1)
If h2.[N5] = h1.[A5] Then
u = 8
Do While h1.Cells(u, "J") <> ""
u = u + 1
Loop
h1.Cells(u, "D") = h2.[L13]
h1.Cells(u, "C") = h2.[H13]
h1.Cells(u, "B") = h2.[D13]
h1.Cells(u, "E") = h2.[D17]
h1.Cells(u, "F") = h2.[D20]
h1.Cells(u, "J") = h2.[O18]
h1.Cells(u, "I") = h2.[E7]
h1.Cells(u, "G") = h2.[L11]
h1.Cells(u, "A") = h2.[N6]
h1.Cells(u, col) = arch
End If
l2.Close False
End If
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "YA TERMINE, MARIA"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Respuesta de Adriel Ortiz Mangia
1
H o l a
Te paso la macro act. asumiendo que borrará el rango donde copia los datos
Sub BuscarMatriculas()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("hoja1")
'
If h1.[A5] = "" Then
MsgBox "MARIA, FAVOR PONER LA FECHA DEL DIA"
Exit Sub
End If
'
ruta = "D:\CENTRO EDUCATIVO FE Y ESPERANZA\carpeta de factura\"
'ruta = l1.Path & "\archivos\"
arch = Dir(ruta & h1.[N5] & "*.xls*")
col = "IT"
'
h1.Range("B10:E232").ClearContents
'
Do While arch <> ""
If arch <> l1.Name Then
Set l2 = Workbooks.Open(ruta & arch)
Set h2 = l2.Sheets(1)
If h2.[N5] = h1.[A5] Then
u = 8
Do While h1.Cells(u, "J") <> ""
u = u + 1
Loop
h1.Cells(u, "D") = h2.[L13]
h1.Cells(u, "C") = h2.[H13]
h1.Cells(u, "B") = h2.[D13]
h1.Cells(u, "E") = h2.[D17]
h1.Cells(u, "F") = h2.[D20]
h1.Cells(u, "J") = h2.[O18]
h1.Cells(u, "I") = h2.[E7]
h1.Cells(u, "G") = h2.[L11]
h1.Cells(u, "A") = h2.[N6]
h1.Cells(u, col) = arch
End If
l2.Close False
End If
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "YA TERMINE, MARIA"
End Sub
Voy a limpiar desde la A8 hasta la J42 de la hoja 1
Macro actualizada
Sub BuscarMatriculas()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("hoja1")
'
If h1.[A5] = "" Then
MsgBox "MARIA, FAVOR PONER LA FECHA DEL DIA"
Exit Sub
End If
'
ruta = "D:\CENTRO EDUCATIVO FE Y ESPERANZA\carpeta de factura\"
'ruta = l1.Path & "\archivos\"
arch = Dir(ruta & h1.[N5] & "*.xls*")
col = "IT"
'
h1.Range("A8:J42").ClearContents
'
Do While arch <> ""
If arch <> l1.Name Then
Set l2 = Workbooks.Open(ruta & arch)
Set h2 = l2.Sheets(1)
If h2.[N5] = h1.[A5] Then
u = 8
Do While h1.Cells(u, "J") <> ""
u = u + 1
Loop
h1.Cells(u, "D") = h2.[L13]
h1.Cells(u, "C") = h2.[H13]
h1.Cells(u, "B") = h2.[D13]
h1.Cells(u, "E") = h2.[D17]
h1.Cells(u, "F") = h2.[D20]
h1.Cells(u, "J") = h2.[O18]
h1.Cells(u, "I") = h2.[E7]
h1.Cells(u, "G") = h2.[L11]
h1.Cells(u, "A") = h2.[N6]
h1.Cells(u, col) = arch
End If
l2.Close False
End If
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "YA TERMINE, MARIA"
End Sub