ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   need to repeat rows at bottom of excel spreadsheet (https://www.excelbanter.com/excel-programming/317477-need-repeat-rows-bottom-excel-spreadsheet.html)

hans[_3_]

need to repeat rows at bottom of excel spreadsheet
 
I found this with google.
If i try this code i get an error in the line: firstPgBk =
ActiveSheet.HPageBreaks(1).Location.Row - 1
can someone tell me whats wrong?

Greetings Hans

Bericht 6 van deze discussie
Van:Art Farrell )
Onderwerp: NEED TO REPEAT ROWS AT THE BOTTOM OF EXCEL SPREAD SHEET


View this article only
Discussies:microsoft.public.excel.programming
Datum:2004-06-07 06:18:43 PST


Hi AQ,

This macro will copy the original sheet to a new sheet and do the work
there. I put statements in to print the sheet and delete it but I turned
these off since you can go to Print Preview to verify that it works as you
want. Let me know if you have questions.

CHORDially,
Art Farrell


Option Explicit
Sub repeatBotRows()

Dim botRows As Range, botCount As Long
Dim firstPgBk As Long, LasRow As Long
Dim totPages As Long, n As Long, m As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Set botRows = Range("2:7")
Sheets("Sheet1").Copy after:=Sheets("Sheets1")
ActiveSheet.Name = "printOrig"
With ActiveSheet.PageSetup
.printtitlerows = "$1:$1"
End With
firstPgBk = ActiveSheet.HPageBreaks(1).Location.Row - 1
botCount = botRows.Rows.Count
LasRow = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
totPages = Application.Ceiling(LasRow / (firstPgBk - botCount - 1), 1)
Range(Rows(firstPgBk - botCount + 1), Rows(firstPgBk)).Select
Selection.EntireRow.Insert Shift:=xlDown
botRows.Copy Range("A" & firstPgBk - botCount + 1)

n = 2
m = 0
Do
Range(Rows(firstPgBk * n - botCount - m), Rows(firstPgBk * n -
m - 1)).Select
Selection.EntireRow.Insert Shift:=xlDown
botRows.Copy Range("A" & firstPgBk * n - botCount - m)
n = n + 1
m = m + 1
Loop Until n totPages
Application.Calculation = xlCalculationAutomatic
' ActiveSheet.PrintOut
' ActiveSheet.Delete
ActiveSheet.Buttons.Delete
Application.DisplayAlerts = True
End Sub




hans[_3_]

need to repeat rows at bottom of excel spreadsheet
 
problem solved

Greetings Hans
"hans" schreef in bericht
...
I found this with google.
If i try this code i get an error in the line: firstPgBk =
ActiveSheet.HPageBreaks(1).Location.Row - 1
can someone tell me whats wrong?

Greetings Hans

Bericht 6 van deze discussie
Van:Art Farrell )
Onderwerp: NEED TO REPEAT ROWS AT THE BOTTOM OF EXCEL SPREAD SHEET


View this article only
Discussies:microsoft.public.excel.programming
Datum:2004-06-07 06:18:43 PST


Hi AQ,

This macro will copy the original sheet to a new sheet and do the work
there. I put statements in to print the sheet and delete it but I turned
these off since you can go to Print Preview to verify that it works as you
want. Let me know if you have questions.

CHORDially,
Art Farrell


Option Explicit
Sub repeatBotRows()

Dim botRows As Range, botCount As Long
Dim firstPgBk As Long, LasRow As Long
Dim totPages As Long, n As Long, m As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Set botRows = Range("2:7")
Sheets("Sheet1").Copy after:=Sheets("Sheets1")
ActiveSheet.Name = "printOrig"
With ActiveSheet.PageSetup
.printtitlerows = "$1:$1"
End With
firstPgBk = ActiveSheet.HPageBreaks(1).Location.Row - 1
botCount = botRows.Rows.Count
LasRow = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
totPages = Application.Ceiling(LasRow / (firstPgBk - botCount - 1), 1)
Range(Rows(firstPgBk - botCount + 1), Rows(firstPgBk)).Select
Selection.EntireRow.Insert Shift:=xlDown
botRows.Copy Range("A" & firstPgBk - botCount + 1)

n = 2
m = 0
Do
Range(Rows(firstPgBk * n - botCount - m), Rows(firstPgBk * n -
m - 1)).Select
Selection.EntireRow.Insert Shift:=xlDown
botRows.Copy Range("A" & firstPgBk * n - botCount - m)
n = n + 1
m = m + 1
Loop Until n totPages
Application.Calculation = xlCalculationAutomatic
' ActiveSheet.PrintOut
' ActiveSheet.Delete
ActiveSheet.Buttons.Delete
Application.DisplayAlerts = True
End Sub







All times are GMT +1. The time now is 07:21 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com