VBA, PrintArea ,Max Ranges

[bewsh1987]

Hi

I need anyone's help

Here is my print area

Each range is selected in each "FOR EACH" loop, The code stops at the range in red below is there a way to bypass the max range input i have 20 more ranges to input


A3:M82,A84:M163,A165:M244,A246:M325,A327:M406,A408:M487,A489:M568,A570:M649,A651:M730,A732:M811,A813:M892,A894:M973,A975:M1054,A1056:M1135,A1137:M1216,A1218:M1297,A1299:M1378,A1380:M1459,A1461:M1540,A1542:M1621,A1623:M1702,A1704:M1783,A1785:M1864,A1866:M1945
here is my code

Sub Loop_Data_Valid()

    Dim LastRow As Long
    Dim LastRow2 As Long
    Dim cell As Range
    Dim MyPrintArea As String
    
        LastRow = Sheets("Contents").Cells(Sheets("Contents").Rows.Count, "K").End(xlUp).Row
        
    Sheets("PDF_VBA").PageSetup.PrintArea = ""
    
For Each cell In Sheets("Contents").Range("K1:K" & LastRow)


If cell.Value = "" Or cell.Offset(0, 3).Value = "" Then
Else




Sheets("Pages").Range("A1") = cell.Offset(0, 3).Value
LastRow2 = Sheets("PDF_VBA").Cells(Sheets("PDF_VBA").Rows.Count, "A").End(xlUp).Row + 2




Sheets("Pages").Range("Print_Area").Copy








    With Sheets("PDF_VBA").Range("A" & LastRow2)
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With




MyPrintArea = MyPrintArea & "," & ("A" & LastRow2 & ":" & "M" & LastRow2 + 79)


Sheets("PDF_VBA").PageSetup.PrintArea = Mid(MyPrintArea, 2, Len(MyPrintArea))
       




End If
Next cell
    



End Sub

 

[CalcSux78]

The max characters for your range is 255. If you break up the total ranges into two or three cells, you can use UNION function to blend together.

Sub testrng()
Dim rng As Range
'posted range split into cells G8 & G9
Set rng = Union(Range([G8]), Range([G9]))
rng.Interior.ColorIndex = 6
End Sub