Sub zapis_wart()

Dim arkusz As Integer, zakres As String, rn As Range
Dim i As Integer, j As Integer
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
zakres = "A1:F15"
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
For arkusz = 1 To Sheets.Count

    With Sheets(arkusz)
      .PageSetup.PrintArea = zakres
      
i = Range(zakres).Rows.Count
j = Range(zakres).Columns.Count
Set rn = Union(.Range(.Cells(i + 1, "A"), .Cells(.Rows.Count, .Columns.Count)), .Range(.Cells(1, j + 1), .Cells(i, .Columns.Count)))
   
   rn.Cells.Clear
 
      .Select
    
    Range(zakres).Copy
    .Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    Range("A1").Select
    
   End With
    
Next arkusz
    

End Sub