find vertical page break and paste cells

Cristicrs

New Member
Joined
Dec 29, 2017
Messages
6
Hi,

I'm not an expert in VBA but I'm trying to learn.
I have the following code ( I get inspired from other posts ) :

Sub WorkSheet_Activate()

Application.ScreenUpdating = False

Unprotect ""

Range("C8:AC28").Columns.AutoFit

Dim cl As Range, rtest As Range
Set rtest = Range("F28", Range("F28").End(xlToRight))
For Each cl In rtest
If Not cl.Value <> 0 Then
cl.EntireColumn.Hidden = True
End If
Next cl

Application.ScreenUpdating = True

Protect ""

End Sub

In this way the table becomes dynamic and Vertical page break is not fixed.
I need a code which will find vertical page break and it will paste copied A1:A3 ( from the same sheet ), next to vertical page break, and copied G4 and G5 in the fifth cell after page break.
Thank you for your help.
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Take a look at this thread. Don't know if the page brake you're looking for will exist or not.
 
Upvote 0
Thank you for the replay.
I already looked to that, it shows vertical page break but I’m unable to figure it out how to copy and paste the cells next to it.
 
Upvote 0
try something along the lines of this
Code:
   With ActiveSheet
        For i = 1 To .VPageBreaks.Count
            .Range("A1:A3").Copy .Cells(1, .VPageBreaks(i).Location.Column)
            .Range("G4:G5").Copy .Cells(4, .VPageBreaks(i).Location.Column + 4)
        Next i
    End With
 
Upvote 0
Thank you, it works perfectly.

Now I noticed that if the sheet will get smaller and only one page will be printed, the copied cells will still be printed on the second blank page, also the cells will remained inserted if the table will shrink.
I need something more added which will delete unnecessary inputs.
 
Upvote 0
Those page breaks are a moving target so will need to keep track of the cells copied to with the publicly declared range rng in order to clear them.
Be aware the range will be unknown once the workbook is closed so make sure you run the Remove sub before closing.
Code:
Option Explicit
    Dim rng As Range


Sub InsertAfterPageBreaks()

    Dim i As Long

If Not rng Is Nothing Then rng.ClearContents
Set rng = Nothing

With ActiveSheet
    For i = 1 To .VPageBreaks.Count
        .Range("A1:A3").Copy .Cells(1, .VPageBreaks(i).Location.Column)
        If rng Is Nothing Then
            Set rng = .Cells(1, .VPageBreaks(i).Location.Column).Resize(3)
        Else
            Set rng = Union(rng, .Cells(1, .VPageBreaks(i).Location.Column).Resize(3))
        End If
        .Range("G4:G5").Copy .Cells(4, .VPageBreaks(i).Location.Column + 4)
        Set rng = Union(rng, .Cells(4, .VPageBreaks(i).Location.Column + 4).Resize(2))
    Next i
End With
End Sub


Sub RemoveAfterPageBreaks()
If Not rng Is Nothing Then rng.ClearContents
Set rng = Nothing
End Sub
 
Last edited:
Upvote 0
I`m trying to arrange this vba code for someone who is not so familiar with excel, so can we insert the last sub "RemoveAfterPageBreaks()" in the "InsertAfterPageBreak" code with an IF statement, in this way will be automatically run with the "workSheetActivate".

This should be look like this
#Option Explicit
Dim rng As Range
Sub WorkSheet_Activate()

'Inlatura Frameurile de pe ecran
Application.ScreenUpdating = False

'Unprotect macro
Unprotect ""

'Dimensioneaza coloanele
Range("C8:AC28").Columns.AutoFit

'Arata/Ascunde Cloane cu zero
Dim cl As Range, rtest As Range
Set rtest = Range("F28", Range("F28").End(xlToRight))
For Each cl In rtest
If Not cl.Value <> 0 Then
cl.EntireColumn.Hidden = True
End If
Next cl

'Copiaza Header si paste daca sunt doua pagini



Dim i As Long

If Not rng Is Nothing Then rng.ClearContents
Set rng = Nothing

With ActiveSheet
For i = 1 To .VPageBreaks.Count
.Range("A1:A3").Copy .Cells(1, .VPageBreaks(i).Location.Column)
If rng Is Nothing Then
Set rng = .Cells(1, .VPageBreaks(i).Location.Column).Resize(3)
Else
Set rng = Union(rng, .Cells(1, .VPageBreaks(i).Location.Column).Resize(3))
End If
.Range("E3").Copy .Cells(3, .VPageBreaks(i).Location.Column + 3)
Set rng = Union(rng, .Cells(3, .VPageBreaks(i).Location.Column + 3).Resize(2))
.Range("D4").Copy .Cells(4, .VPageBreaks(i).Location.Column + 3)
Set rng = Union(rng, .Cells(4, .VPageBreaks(i).Location.Column + 3).Resize(2))
Next i
End With
End Sub

Sub RemoveAfterPageBreaks()
If Not rng Is Nothing Then rng.ClearContents
Set rng = Nothing

'Protect macro
Protect ""

'Inlatura Frameurile de pe ecran
Application.ScreenUpdating = True
End Sub


Thank you once again for your quick reply and for your help and a Happy New Year!!
 
Upvote 0
You will notice the 'RemoveAfterPageBreaks' is actually the first thing in my 'InsertAfterPageBreaks' sub after declaring the i variable.

rng will always be nothing on the first run of 'InsertAfterPageBreaks' and do nothing. It's only there to clear the cells for subsequent runs of the macro without the workbook being closed.

The contents of the rng variable are held in memory and will be lost once the workbook is closed.
The Remove macro should be run before closing the workbook, perhaps in the Workbook_BeforeClose event, in order to clear the 'copied to' cells while they are still known.

and a Happy New Year to you too.
 
Upvote 0
Hi,
Sorry for the late response. I can`t find the option to attach a picture, so i will try to describe the problem.
When the columns are next to Vertical Page Break on the left side, the code inserts the copied cells on the right side even if the row is empty.
 
Upvote 0

Forum statistics

Threads
1,213,539
Messages
6,114,221
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top