Pregunta para luismondelo
Hola Luis:
tu macro para el informe es perfecta, funciona de maravilla. Muchas gracias por ayudarme, pero te quería hacer la siguiente pregunta:
¿Que tengo que modificar para que en vez de empezar a realizarme el informe en la fila 1 lo haga en la fila 7?.
Muchas gracias EXCELencia.
Un saludo
1 Respuesta
Respuesta de Luis Mondelo
1
Te mando aquí la macro íntegramente para que la sustituyas por completo y evitar errores:
(Recuerda finalizar por favor)
Sub informe_luis()
'por luismondelo
pase1 = MsgBox("Desea realizar el informe de medallas???", vbYesNo, "ATENCION")
If pase1 = vbNo Then Exit Sub
Sheets("informe").UsedRange.Clear
Sheets("informe").Select 'escribimos titulos en la fila 6 de informe para que los datos empiecen desde la fila 7
Range("a6").Value = "NOMBRE"
Range("B6").Value = "TIPO"
Range("C6").Value = "DENOMINACION"
Range("D6").Value = "FECHA"
'+++++++++++++++++++++++++++++++++++++++++++++
For x = 8 To Sheets.Count
Sheets(x).Select
ActiveSheet.Shapes("caja").Select
With Selection
nombre = .Text
End With
'+++++++++++++++++++++++++++++
contara = Application.WorksheetFunction.CountA(Range("b8:b" & Range("b65000").End(xlUp).Row + 1))
If contara = 0 Then GoTo salto1
Range("b8:c" & Range("b65000").End(xlUp).Row).Copy
Sheets("informe").Range("c65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Sheets("informe").Select
Range("b65000").End(xlUp).Offset(1, 0).Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ActiveCell.Value = Sheets(x).Range("a6")
ActiveCell.Offset(1, 0).Select
Loop
Sheets(x).Select
'+++++++++++++++++++++++++++++++
salto1:
contara2 = Application.WorksheetFunction.CountA(Range("e8:e" & Range("e65000").End(xlUp).Row + 1))
If contara2 = 0 Then GoTo salto2
Range("e8:f" & Range("e65000").End(xlUp).Row).Copy
Sheets("informe").Range("c65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Sheets("informe").Select
Range("b65000").End(xlUp).Offset(1, 0).Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ActiveCell.Value = Sheets(x).Range("d6")
ActiveCell.Offset(1, 0).Select
Loop
Sheets(x).Select
'+++++++++++++++++++++++++++
salto2:
contara3 = Application.WorksheetFunction.CountA(Range("h8:h" & Range("h65000").End(xlUp).Row + 1))
If contara3 = 0 Then GoTo salto3
Range("h8:i" & Range("h65000").End(xlUp).Row).Copy
Sheets("informe").Range("c65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Sheets("informe").Select
Range("b65000").End(xlUp).Offset(1, 0).Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ActiveCell.Value = Sheets(x).Range("g6")
ActiveCell.Offset(1, 0).Select
Loop
'++++++++++++++++++++++++++++
salto3:
Sheets("informe").Select
Range("a65000").End(xlUp).Offset(1, 0).Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ActiveCell.Value = nombre
ActiveCell.Offset(1, 0).Select
Loop
'++++++++++++++++++++++++++++
Next
End Subrecuerda finalizar
