Belirtrıilen aralıktaki hücreler..

[k0081]

Merhaba arkadaşlar;

bir excel dosyası içine farklı sheet lerde kullanılmak üzere bir macro yazmak istiyorum..

macro içeriği : herhangi bir sheet içinde açılan pencereye yada başka şekilde,, A1 ile F19 arasını ayrı bir excel dosyası olarak kaydetmek.. A1 ve F19 örnek olarak verilmiştir.. diğer sheetler de bu farklı olabilir..

yardımcı arkadaşa şimdiden teşekkürler..

 

[Ömer]

Merhaba,

Sorunuzu küçük bir örnek ile destekleyip detaylı açıklarmısınız.

.

 

[k0081]

merhaba.

http://hotfile.com/dl/134030191/5f1a2e7/Kitap1.xlsx.html

örnek dosyayı gönderiyorum.. burda her sayfada farklı bir tablo var. sonuçta bunların hücre adresleri belli.. ben örnek olarak her sayfada bir tablo yaptım.. amacım eklediğim macronun her sayfada çalışabilmesi... ( yani aynı excel dosyası için söylüyorum.) istediğim sayfadaki tabloyu belirteceğim hücre adresi ile ayrı bir excel sayfası olarak kaydetmesi.. sadece o an bulunduğum sayfa ve belirttiğim hücre adresindeki tabloyu kaydetmesi..

 

[Ömer]

merhaba.
örnek dosyayı gönderiyorum.. burda her sayfada farklı bir tablo var. sonuçta bunların hücre adresleri belli.. ben örnek olarak her sayfada bir tablo yaptım.. amacım eklediğim macronun her sayfada çalışabilmesi... ( yani aynı excel dosyası için söylüyorum.) istediğim sayfadaki tabloyu belirteceğim hücre adresi ile ayrı bir excel sayfası olarak kaydetmesi.. sadece o an bulunduğum sayfa ve belirttiğim hücre adresindeki tabloyu kaydetmesi..

Kodları standart bir module kopyalayın.

Hangi sayfadaysanız kodları çalıştırdığınız da alan seçmeniz için InputBox gelecektir, bu kutuda kaydedilecek alanı fare ile seçin ve tamam ile işlemi bitirin. Bu işlemden sonra masa üstünde bulunduğunuz sayfa adı ile yeni bir dosya kaydedilir.

Sub AlanKaydet()
 
    Dim alan As Range, d() As String, kopya As String
    Dim dosya As String, dosyaAdı As String, uzantı As String
 
    On Error Resume Next
    Application.DisplayAlerts = False
 
    Set alan = Application.InputBox("Alan Secin", "Farklı Kaydetme", Type:=8)
 
    If alan Is Nothing Then Exit Sub
 
    kopya = Split(alan.Address, ":")(0)
 
    With ActiveWorkbook
        d = Split(.Name, ".")
        uzantı = d(UBound(d))
        dosyaAdı = ActiveSheet.Name
 
        dosya = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") & _
                Application.PathSeparator & dosyaAdı & "." & uzantı
 
    End With
 
        ActiveSheet.Copy
        ActiveWorkbook.SaveAs dosya
        Cells.Clear
        alan.Copy Range(kopya)
        ActiveWorkbook.Save
        ActiveWorkbook.Close
 
    Application.DisplayAlerts = True
 
End Sub

.

 

[k0081]

Ömer

hocam çok teşekkür ederim.. tamamdır.. sağol..