Reporte Mensual para Consolidado Anual
A los miembros de este foro, en esta oportunidad requiero de una macro que me permita copiar el nombre que se ubica en la CELDA C2 a la CELDA AR8 de cada reporte que a continuación detallo en las imágenes:
Y lo que requiero es que después haber ejecutado el primer archivo y con ayuda de la instrucción Range("B8:AO" & Range("B" & Rows. Count).End(xlUp). Row). Copy, que permite copiar de cada archivo el ultimo valor encontrado de cada reporte, y que luego otra rutina copie el valor de la CELDA C2 a la CELDA AR8 hasta el ultimo valor que contiene los datos con la instrucción anteriormente descrita, por lo que el reporte quedara asi:
Posteriormente volveré a copiar nuevamente otro archivo con diferentes datos y nombre en la CELDA C2.
A la espera de su respuesta quedo de Uds. Y espero haberme explicado.
1 respuesta
Buenos dias Elsa, acá dejo la macro que por cierto quedo excelente, con la instrucción:
Range("B8:AO" & Range("B" & Rows.Count).End(xlUp).Row).Copy
Dim R
Sub abrir()
Application.ScreenUpdating = False
file = Application.GetOpenFilename
If file = False Then
Exit Sub
Else
Workbooks.OpenText Filename:=file
End Ifa = ActiveWorkbook.Name
UserForm1.Show
Range("B8:AO" & Range("B" & Rows.Count).End(xlUp).Row).Copy
Windows("PLANTILLA ELECTRONICA.xlsm").Activate
n = Range("b8").Value
If n <> Empty Then
Range("b8").End(xlDown).Offset(1, 0).Select
Else
Range("b8").Select
End IfSelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Range("B3").Select
Range("B1").Select
Windows(a).Activate
Application.CutCopyMode = False
ActiveWindow.Close savechanges:=False
Application.ScreenUpdating = True
Copiando
End Sub
Sub Copiando()
resultado = MsgBox("¿Desea copiar otro libro?", vbYesNo, "IMPORTANTE")
If resultado = vbYes Then
abrir
End If
End Sub
Sub Verificar()
R = Hoja1.Range("A2").End(xlUp).Row
For i = 2 To R
If Hoja2.Cells(i, 1) = "" Then
Final = i
Exit For
End If
Next
End Sub
Sub c()
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
R = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
abrir
End Sub
y acá dejo la imagen, como deberá queda el archivo final.
A la espera de tu respuesta quedo siempre agradecido.
Bien, solo se necesitan cambios en esta macro:
Sub abrir()
Application.ScreenUpdating = False
file = Application.GetOpenFilename
If file = False Then
Exit Sub
Else
Workbooks.OpenText Filename:=file
End If
a = ActiveWorkbook.Name
UserForm1.Show
Range("B8:AO" & Range("B" & Rows.Count).End(xlUp).Row).Copy
Windows("PLANTILLA ELECTRONICA.xlsm").Activate
n = Range("b8").Value
If n <> Empty Then
Range("b8").End(xlDown).Offset(1, 0).Select
Else
Range("b8").Select
End If
'----guarda la 1er fila destino
ini = ActiveCell.Row
'----
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'***** guarda la última fila ocupada
fini = Range("B" & Rows.Count).End(xlUp).Row
'en este rango se pega el valor de C2 del libro anterior
Windows(a).ActiveSheet.Range("C2").Copy Destination:=Range("R" & ini & ":R" & fini)
'******
'Range("B3").Select
Range("B1").Select
Windows(a).Activate
Application.CutCopyMode = False
ActiveWindow.Close savechanges:=False
Application.ScreenUpdating = True
Copiando
End Sub
Sdos!
¡Gracias!
Buenas días Elsa, la macro quedo excelente con la ultima modificación, por lo quedo muy agradecido por el apoyo desinteresado para personas como yo desean aprender mas.
