Baskı alanı aralığını hücreden alma

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Değişken olduğu için baskı alanı aralığını hücreden almak istiyorum.

[COLOR="Red"]    PrintArea = Range(Range("E1").Text)[/COLOR]
    aa = ActiveSheet.PageSetup.PrintArea
    Range(aa).Select

Çalışmama kırmızı satırı ekledim yeterli olmadı. Başka ne eklemeliyim?
Saygılarımla

 

[Emir Hüseyin Çoban]

    Aa = Range(Range("E1").Text)
    ActiveSheet.PageSetup.PrintArea=aa

.

 

[Merhum İdris SERDAR]

.

Makrosuz:

Ad tanımlama ile: örnek;

Print_Area
=INDIRECT(Sheet1!$A$1)

.

 

[Tevfik_Kursun]

Sayın Hüseyin Hocam,
2. satırda

Run-time Error '13':
Type mismatch

şeklinde hata veriyor.
Sayfayı farklı bir dosyaya kopyalayan bir makro bu. Sayfa sayısı değişebildiği için baskı alanını hücreden vermeğe karar verdim. Çalışan makro bu

Sub DosyayaYaz()
    SyfAdi = Cells(1, 1)
    If Sheets(SyfAdi).PageSetup.PrintArea = "" Then
        MsgBox "Yazdırma Alanı Belirlenmemiş!", vbCritical
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Sheets(SyfAdi).Copy After:=Sheets(Sheets.Count)
    ActiveWindow.Zoom = 90
    
    aa = ActiveSheet.PageSetup.PrintArea
    Range(aa).Select
    
    With Selection
        ilk_sat = .Row
        ilk_adres = Split(.Address, "$")(1)
        son_adres = Split(.Address, "$")(3)
        ilk_adres = Split(Cells(1, Columns(ilk_adres).Column - 1).Address, "$")(1)
        son_adres = Split(Cells(1, Columns(son_adres).Column + 1).Address, "$")(1)
    End With
    
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    Columns(son_adres & ":CC").Delete Shift:=xlToLeft
    Rows("1:" & ilk_sat - 1).Delete Shift:=xlUp
    Columns("A:" & ilk_adres).Delete Shift:=xlToLeft
    Range("A1").Select
    
    yol = ThisWorkbook.Path & "\"
    isim = SyfAdi
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=yol & isim & ".xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveSheet.Name = isim
    ActiveWindow.Close True
    
    ActiveSheet.Delete
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
  Range("A4").Select
End Sub

Saygılarımla

 

[Tevfik_Kursun]

Sayın İdris Hocam,
Sizin parçayı henüz inceleyemedim. Çözümlerse hemen haber vereceğim. Tüm ilgilenen arkadaşlara teşekkür ederim.
Saygılarımla

 

[Tevfik_Kursun]

Sayın İdris Hocam,

    Print_Area
    INDIRECT (ActiveSheet("F1"))

Print_Area lafı için belirlenmemiş lafını yazdı
Saygılarımla

 

[Merhum İdris SERDAR]

Sayın İdris Hocam,

    Print_Area
    INDIRECT (ActiveSheet("F1"))

Print_Area lafı için belirlenmemiş lafını yazdı
Saygılarımla

Bu yazdığım İngilizce sürüm içindi.

1. F1 hücresine; örneğin F3:H10 yazın.

2. Sayfada herhangi bir alanı seçerek yazdırma alanı olarak belirleyin.

3. Bu belirlenen yazdırma alanın yerine;

=DOLAYLI(Sheet1!$F$1)

yazın.


Örnek dosya ekte.

.

 

[Tevfik_Kursun]

Sayın İdris Hocam,
30 kadar sayfa var. Bu ad tanımlama işlemini her sayfa için yapmalıyım değil mi?
4. mesajdaki makroya eklentiyi yapabilsem daha kolay olabilir belki.
İlginize çok teşekkür ederim.
Saygılarımla

 

[heavysharpa]

Aynı dertten muzdarip...

Arkadaşlar aşağıdaki gibi yaklaşık 53 sayfam var ve bu sayfalardaki a2 sütunundaki değerleri a51 e kadar sayacak ve eğer değer sıfırıdan büyük ise bulduğu satıra kadar; örneğin a2=0 ve a3=2 a4=3 gibi değerleri gördüğünde son değer satırı ( sıfırdan büyük olan mesela a4 ) a1:k4 e kadar alanı yazdıracak..

Dim i As Integer



Worksheets("MINIKUTUBEYAZKESIM").Select

For i = 2 To Range("A65536").End(3).Row
        If Cells(i, "A").Value > 0 Then
            ActiveSheet.PageSetup.PrintArea = "$A$1:$N$" & i
        End If
    Next i
        ActiveSheet.PrintPreview
    
    i = Empty



Worksheets("KUCUKKUTUBEYAZKESIM").Select

For i = 2 To Range("A65536").End(3).Row
        If Cells(i, "A").Value > 0 Then
            ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & i
        End If
    Next i
        ActiveSheet.PrintPreview
    
    i = Empty
    

Worksheets("KUCUKKUTURENKLIKESIM").Select

For i = 2 To Range("A65536").End(3).Row
        If Cells(i, "A").Value > 0 Then
            ActiveSheet.PageSetup.PrintArea = "$A$1:$N$" & i
        End If
    Next i
        ActiveSheet.PrintPreview
    
    i = Empty




Worksheets("EKONKUTUBEYAZKESIM").Select

For i = 2 To Range("A65536").End(3).Row
        If Cells(i, "A").Value > 0 Then
            ActiveSheet.PageSetup.PrintArea = "$A$1:$H$" & i
        End If
    Next i
        ActiveSheet.PrintPreview
    
    i = Empty


Worksheets("EKONKUTULAMINEKESIM").Select

For i = 2 To Range("A65536").End(3).Row
        If Cells(i, "A").Value > 0 Then
            ActiveSheet.PageSetup.PrintArea = "$A$1:$N$" & i
        End If
    Next i
        ActiveSheet.PrintPreview
    
    i = Empty


Worksheets("LUKSKUTUBEYAZKESIM").Select

For i = 2 To Range("A65536").End(3).Row
        If Cells(i, "A").Value > 0 Then
            ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & i
        End If
    Next i
        ActiveSheet.PrintPreview
    
    i = Empty


Worksheets("LUKSKUTULAMINEKESIM").Select

For i = 2 To Range("A65536").End(3).Row
        If Cells(i, "A").Value > 0 Then
            ActiveSheet.PageSetup.PrintArea = "$A$1:$N$" & i
        End If
    Next i
        ActiveSheet.PrintPreview
    
    i = Empty



Worksheets("BUYUKKUTUBEYAZKESIM").Select

For i = 2 To Range("A65536").End(3).Row
        If Cells(i, "A").Value > 0 Then
            ActiveSheet.PageSetup.PrintArea = "$A$1:$N$" & i
        End If
    Next i
        ActiveSheet.PrintPreview
    
    i = Empty




Worksheets("BUYUKKUTULAMINEKESIM").Select

For i = 2 To Range("A65536").End(3).Row
        If Cells(i, "A").Value > 0 Then
            ActiveSheet.PageSetup.PrintArea = "$A$1:$N$" & i
        End If
    Next i
        ActiveSheet.PrintPreview
    
    i = Empty




' -----  YAN RAYLAR KESİM RAPORU  ------------------


Worksheets("SUPEREKONYANRAYBEYAZ").Select

For i = 2 To Range("A65536").End(3).Row
        If Cells(i, "A").Value > 0 Then
            ActiveSheet.PageSetup.PrintArea = "$A$1:$e$" & i
        End If
    Next i
        ActiveSheet.PrintPreview
    
    i = Empty

Böyle bir kod yazdım, acaba doğrumu?