find vertical page break and paste cells

[Cristicrs]

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.

 

[NoSparks]

Take a look at this thread. Don't know if the page brake you're looking for will exist or not.

 

[Cristicrs]

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.

 

[NoSparks]

try something along the lines of this

   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

 

[Cristicrs]

Thank you, it works perfectly.

 

[Cristicrs]

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.

 

[NoSparks]

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.

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

 

[Cristicrs]

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!!

 

[NoSparks]

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.

 

[Cristicrs]

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.