• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kapalı Olan Dosyaya Kayıt,

S

sabri şirin

Katılım
30 Haziran 2007
Mesajlar
44
Excel Vers. ve Dili
Ofis XP Türkçe
Merhaba,
Aşşağıda ki kod ile normal kaydımı yapabiliyorum. Ayrıca, Kapalı olan "Teklif Arşiv" Adında ayrı bir dosyaya da kayıt yapmak istiyorum.
Bunun için Koda nasıl bir ilave yapmamız gerekir?
Kaydedilecek olan Satır ve Sütunlar aynı....
Saygılarımla...
Sub Teklifprinter()
Application.Dialogs(xlDialogPrint).Show

say = Worksheets("Arşiv").Range("B65530").End(3).Row + 1
Worksheets("Arşiv").Range("B" & say) = Worksheets("Teklif").Range("L39")
Worksheets("Arşiv").Range("C" & say) = Worksheets("Teklif").Range("L41")
Worksheets("Arşiv").Range("D" & say) = Worksheets("Teklif").Range("L43")
Worksheets("Arşiv").Range("E" & say) = Worksheets("Teklif").Range("H9")
Worksheets("Arşiv").Range("F" & say) = Worksheets("Teklif").Range("E46")
Worksheets("Arşiv").Range("G" & say) = Worksheets("Teklif").Range("E44")
Worksheets("Arşiv").Range("H" & say) = Worksheets("Teklif").Range("G46")
Worksheets("Arşiv").Range("I" & say) = Worksheets("Teklif").Range("A36")
Worksheets("Arşiv").Range("J" & say) = Worksheets("Teklif").Range("D36")
Worksheets("Arşiv").Range("K" & say) = Worksheets("Teklif").Range("E36")
Worksheets("Arşiv").Range("L" & say) = Worksheets("Teklif").Range("F36")
Worksheets("Arşiv").Range("M" & say) = Worksheets("Teklif").Range("G36")
Worksheets("Arşiv").Range("N" & say) = Worksheets("Teklif").Range("A37")
Worksheets("Arşiv").Range("O" & say) = Worksheets("Teklif").Range("D37")
Worksheets("Arşiv").Range("P" & say) = Worksheets("Teklif").Range("E37")
Worksheets("Arşiv").Range("Q" & say) = Worksheets("Teklif").Range("F37")
Worksheets("Arşiv").Range("R" & say) = Worksheets("Teklif").Range("G37")
Worksheets("Arşiv").Range("S" & say) = Worksheets("Teklif").Range("A38")
Worksheets("Arşiv").Range("T" & say) = Worksheets("Teklif").Range("D38")
Worksheets("Arşiv").Range("U" & say) = Worksheets("Teklif").Range("E38")
Worksheets("Arşiv").Range("V" & say) = Worksheets("Teklif").Range("F38")
Worksheets("Arşiv").Range("W" & say) = Worksheets("Teklif").Range("G38")
Worksheets("Arşiv").Range("X" & say) = Worksheets("Teklif").Range("A39")
Worksheets("Arşiv").Range("Y" & say) = Worksheets("Teklif").Range("D39")
Worksheets("Arşiv").Range("Z" & say) = Worksheets("Teklif").Range("E39")
Worksheets("Arşiv").Range("AA" & say) = Worksheets("Teklif").Range("F39")
Worksheets("Arşiv").Range("AB" & say) = Worksheets("Teklif").Range("G39")
Worksheets("Arşiv").Range("AC" & say) = Worksheets("Teklif").Range("A40")
Worksheets("Arşiv").Range("AD" & say) = Worksheets("Teklif").Range("D40")
Worksheets("Arşiv").Range("AE" & say) = Worksheets("Teklif").Range("E40")
Worksheets("Arşiv").Range("AF" & say) = Worksheets("Teklif").Range("F40")
Worksheets("Arşiv").Range("AG" & say) = Worksheets("Teklif").Range("G40")
Worksheets("Arşiv").Range("AH" & say) = Worksheets("Teklif").Range("A41")
Worksheets("Arşiv").Range("AI" & say) = Worksheets("Teklif").Range("D41")
Worksheets("Arşiv").Range("AJ" & say) = Worksheets("Teklif").Range("E41")
Worksheets("Arşiv").Range("AK" & say) = Worksheets("Teklif").Range("F41")
Worksheets("Arşiv").Range("AL" & say) = Worksheets("Teklif").Range("G41")
Worksheets("Arşiv").Range("AM" & say) = Worksheets("Teklif").Range("H36")
Worksheets("Arşiv").Range("AN" & say) = Worksheets("Teklif").Range("M46")
Worksheets("Arşiv").Range("AO" & say) = Worksheets("Teklif").Range("P40")
Worksheets("Arşiv").Range("AP" & say) = Worksheets("Teklif").Range("P39")
End Sub
Genişletmek için tıkla ...
 
Son düzenleme:
(Çözüldü)Kapalı Olan Dosyaya Kayıt,

Üyelerden merak edenlerin yararlanabilmesi için;
Murat OSMA Beyin verdiği cevap aşşağıda verilmiştir.
Kendilerine Teşekkür ederim.
Aynı Klasör içinde "Teklif Arşiv" dosyası ve Sekmede ise "Arşiv" ismi olması gerekmektedir.
Sub Emre()
Dim say As Integer
Application.ScreenUpdating = False
With Worksheets("Arşiv")
say = Worksheets("Arşiv").Range("B65530").End(3).Row + 1
.Range("B" & say) = Worksheets("Teklif").Range("L39")
.Range("C" & say) = Worksheets("Teklif").Range("L41")
.Range("D" & say) = Worksheets("Teklif").Range("L43")
.Range("E" & say) = Worksheets("Teklif").Range("H9")
.Range("F" & say) = Worksheets("Teklif").Range("E46")
.Range("G" & say) = Worksheets("Teklif").Range("E44")
.Range("H" & say) = Worksheets("Teklif").Range("G46")
.Range("I" & say) = Worksheets("Teklif").Range("A36")
.Range("J" & say) = Worksheets("Teklif").Range("D36")
.Range("K" & say) = Worksheets("Teklif").Range("E36")
.Range("L" & say) = Worksheets("Teklif").Range("F36")
.Range("M" & say) = Worksheets("Teklif").Range("G36")
.Range("N" & say) = Worksheets("Teklif").Range("A37")
.Range("O" & say) = Worksheets("Teklif").Range("D37")
.Range("P" & say) = Worksheets("Teklif").Range("E37")
.Range("Q" & say) = Worksheets("Teklif").Range("F37")
.Range("R" & say) = Worksheets("Teklif").Range("G37")
.Range("S" & say) = Worksheets("Teklif").Range("A38")
.Range("T" & say) = Worksheets("Teklif").Range("D38")
.Range("U" & say) = Worksheets("Teklif").Range("E38")
.Range("V" & say) = Worksheets("Teklif").Range("F38")
.Range("W" & say) = Worksheets("Teklif").Range("G38")
.Range("X" & say) = Worksheets("Teklif").Range("A39")
.Range("Y" & say) = Worksheets("Teklif").Range("D39")
.Range("Z" & say) = Worksheets("Teklif").Range("E39")
.Range("AA" & say) = Worksheets("Teklif").Range("F39")
.Range("AB" & say) = Worksheets("Teklif").Range("G39")
.Range("AC" & say) = Worksheets("Teklif").Range("A40")
.Range("AD" & say) = Worksheets("Teklif").Range("D40")
.Range("AE" & say) = Worksheets("Teklif").Range("E40")
.Range("AF" & say) = Worksheets("Teklif").Range("F40")
.Range("AG" & say) = Worksheets("Teklif").Range("G40")
.Range("AH" & say) = Worksheets("Teklif").Range("A41")
.Range("AI" & say) = Worksheets("Teklif").Range("D41")
.Range("AJ" & say) = Worksheets("Teklif").Range("E41")
.Range("AK" & say) = Worksheets("Teklif").Range("F41")
.Range("AL" & say) = Worksheets("Teklif").Range("G41")
.Range("AM" & say) = Worksheets("Teklif").Range("H36")
.Range("AN" & say) = Worksheets("Teklif").Range("M46")
.Range("AO" & say) = Worksheets("Teklif").Range("P40")
.Range("AP" & say) = Worksheets("Teklif").Range("P39")
.Range("B65536").End(3).Resize(, 41).Copy
End With
Workbooks.Open (ThisWorkbook.Path & "\Teklif Arşiv.xls")
ActiveSheet.Range("b65536").End(3)(2, 1).PasteSpecial
Application.CutCopyMode = False
Application.ScreenUpdating = True
ActiveWorkbook.Close True
End Sub
Genişletmek için tıkla ...
 
günaydın;

sadece teklif arşiv sayfasında saklamak için ne yapmalıyız.
 
Teklif Arşiv isimli bir sayfa yok...
 
iki dosya olsa biri veri girişi birisi depolama
ben ekteki gibi dosyalamak istiyorum.
 

Ekli dosyalar

Şu kodları deneyiniz;
Kod: 
Sub Emre()
    Dim i As Integer
    With Application
        .ScreenUpdating = False
            For i = 1 To Range("A65536").End(3).Row
                Range("A1:A" & i).Copy
            Next i
            Workbooks.Open (ThisWorkbook.Path & "\Teklif Arşiv.xls")
            ActiveSheet.Range("B65536").End(3)(2, 1).PasteSpecial Paste:=xlPasteAll, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    ActiveWorkbook.Close True
    i = Empty
End Sub
 
veri leri a1-a5-b9 gibi farlılık gösterirse ne yapmamız lazım?
 
benim kullandığım performans değerlendirmesi diye bir çalışmam var.
orada değişik hücrelerden veri aktarıyor. bunun için ne yapmam lazım.
 
İmzamda da göreceğiniz gibi: sonradan değişen dosyalarla ilgilenmiyorum...
Ayrıca sitede bu konudu yüzlerce örnek var. Arama yapabilirsiniz. Tekrar tekrar aynı konulardan bahsetmenin bir anlamı yok..
Sabri Bey'in mesajını referans alabilirsiniz. Kendi dosyanıza göre uyarlayabilirsiniz.
 
Son düzenleme:
yardımcı olabilirseniz cok iyi olur
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst