Nie wiem skąd pobierasz Zakres więc wpisałem na stałe:
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 |