• DİKKAT

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

başka kitaptan veri çekip yeni sayfalar oluşturarak...

Selam,

Halit bey haklısınız sizin gözünüzle göremediğim için sorularımı eksik soruyor olabilirim.

Kodları denedim. Range sınıfının select yöntemi başarısız. diye hata alıyorum. f8 e bastım sarı ile işaretli olan satırı ' ile devre dışı bıraktım 'Range("a2").Select. Yine hata vermesine karşın genel itibari ile,

-yeni sayfa açtı
-sayfaya benim istediğim yerden (a3 hücresinden tarih ismi) isim verdi
-sayfayı kopyaladı yapıştırdı ama biçimleme yok.

ancak

-yeni açılan sayfaları başa atıyor en sona atmasını istiyorum
-sayfayı kopyalarken biçimi ve sütun genişliklerinide aynen kopyalamasını istiyorum.
-işlem tamamlandı yazısı yerine hata alıyorum. bu hatanın düzeltilmesini

sevgi ve saygılarımla rica ederim.

Ayrıca unutuyordum.

GENEL diye bir sayfa var aynı kitabın içinde.

yeni sayfa açıp aktarma yaparken aynı anda birde o sayfayı doldurmasını rica ediyorum.

-her yeni açılan sayfaya kopyalanan bilgilerden
fatura tarihi
teslimat tarihi
ve teslim süresini ilgili alanlara alt alta özet olarak sıralamasını istiyorum.
yani 1 ayın özeti şeklinde.

Bu sefer detaylı anlatayım dedim ama bu seferde kafanızı karıştırmamışımdır umarım.

Tekrar teşekkür ederim. Kolay gelsin.

Sizin eklediğiniz dosyalar ofis 2003 formatında oysa siz ofis 2007 kullanıyorsunuz ben ofis 2003 kullanıyorum kodlar ben çalışıyor

Hata aldığınız sayfanın ve kodların bulunduğu modülün ekran görüntüsünü ekleyin yani hangi sayfada bu hatayı alıyorsunuz ve kodların bulunduğu modüldeki hangi satırda hata alıyorsanız bunların ekran görüntüsünü ekleyin.
 
kod:

Kod:
Private Sub CommandButton2_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sayfa_Adı = ActiveSheet.Name
son = Sheets(Sayfa_Adı).[a65000].End(3).Row
yeni_sayfa = Format(Sheets(Sayfa_Adı).Cells(3, 1).Value, "dd-mm-yyyy")
ekle = 0

For i = 1 To Sheets.Count
If Sheets(i).Name = yeni_sayfa Then
ekle = 1
Exit For
End If
Next i

Sheets(Sayfa_Adı).Range("A2:A" & son & ",D2:D" & son & ",E2:E" & son).Copy
Sheets("GENEL").Select
son3 = Sheets("GENEL").[a65000].End(3).Row + 1
Sheets("GENEL").Range("a" & son3).Select
ActiveSheet.Paste
Sheets("GENEL").Range("A1").Select

Sheets(Sayfa_Adı).Range("A2:E" & son).Copy
If ekle = 0 Then

Sheets.Add

Sheets(ActiveSheet.Name).Range("A2").Select

ActiveSheet.Paste
Sheets(ActiveSheet.Name).Name = yeni_sayfa

Sheets(yeni_sayfa).Move After:=Sheets(Sheets.Count)


Sheets(yeni_sayfa).Columns("A:E").EntireColumn.AutoFit

Else
Sheets(yeni_sayfa).Select
son2 = Sheets(yeni_sayfa).[a65000].End(3).Row + 1
Sheets(yeni_sayfa).Range("a" & son2).Select
ActiveSheet.Paste
End If


Sheets(yeni_sayfa).Range("A1").Select
Sheets(Sayfa_Adı).Select
Application.CutCopyMode = False
Range("a1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "işlem tamam"
End Sub
 
Halit bey elinize sağlık,

Hepsi olmuş hata da vermedi. Ancak GENEL sayfasıyla ilgili yanlış anlaşılma oldu galiba.

Şöyle izah edeyim.

Her yeni sayfa açtığımız verinin ilk satırındaki Fatura tarihi, Teslim Tarihi ve Teslim süresi GENEL sayfasındaki formata ilave edilecek.

Her yeni veri aktarmamızda sadece tek bir satır ilave edecek.

örnek
fatura tarihi teslim tarihi teslim süresi
01/08/2013 03/08/2013 2
02/08/2013 04/08/2013 2
03/08/2013 05/08/2013 1

gibi her gün için 1 satırı buraya yazacak.

Sayfa açarken aynı sayfa daha önce açılmış tekrar veri yazmasın ve aynı isimli sayfa var diye uyarı versin. bu ekstra bir istek. size kalmış.


Ayrıca hızlı dönüşleriniz içi ayrıca teşekkür ederim.

İyi çalışmalar.
 
kod:

Kod:
Private Sub CommandButton2_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sayfa_Adı = ActiveSheet.Name
son1 = Sheets(Sayfa_Adı).[a65000].End(3).Row
son2 = Sheets("GENEL").[a65000].End(3).Row + 1

yeni_sayfa = Format(Sheets(Sayfa_Adı).Cells(3, 1).Value, "dd-mm-yyyy")


For i = 1 To Sheets.Count
If Sheets(i).Name = yeni_sayfa Then
MsgBox yeni_sayfa & Chr(10) & "Bu sayfa adına daha önceden kayıt yapıldı"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
End If
Next i

Sheets(Sayfa_Adı).Range("A2:E" & son1).Copy
Sheets.Add
Sheets(ActiveSheet.Name).Range("A2").Select
Sheets(ActiveSheet.Name).Paste
Sheets(ActiveSheet.Name).Name = yeni_sayfa
Sheets(yeni_sayfa).Move After:=Sheets(Sheets.Count)
Sheets(yeni_sayfa).Columns("A:E").EntireColumn.AutoFit
Sheets(yeni_sayfa).Range("A1").Select


Sheets("GENEL").Cells(son2, "a").Value = Sheets(Sayfa_Adı).Cells(3, "a").Value
Sheets("GENEL").Cells(son2, "b").Value = Sheets(Sayfa_Adı).Cells(3, "d").Value
Sheets("GENEL").Cells(son2, "c").Value = Sheets(Sayfa_Adı).Cells(3, "e").Value


Sheets(Sayfa_Adı).Select
Sheets(Sayfa_Adı).Range("A1").Select
Application.CutCopyMode = False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "işlem tamam"
End Sub
 
Halit bey tek kelimeyle mükemmelsiniz.

İşlem tamamdır. Emeğiniz için teşekkür ederim.

Hakkınızı helal edin.

İyi Çalışmalar.
 
Farklı format

Halit bey tekrar merhabalar,

Yeni bir rapor lazım oldu bana.
Daha önceki çalıştığımız rapor üzerinde birkaç değişiklik yapmamız gerekiyor.

1- Şablon sayfasındaki tutar kısmına Veri Çalışma kitabındaki L sütunundaki veri alınacak.
2-Yeni sayfalar açıp kopyalarken sayfa ismi yine tarihe göre olacak, başlık yazdığım boş sütunları da birlikte kopyalayacak. (bu sütunları ben el ile dolduracam)
3-tutarı ve problem sütunlarının üstündeki boş satıra ilgili sütunun kaç satırının dolu olduğunu sayıp sayısını yazacak (problem sütunu genelde boş kalabilir. Fatura ile ilgili bir problem varsa dolacak o sütunlar)
4-Yine Genel sayfasına her yeni açılan sayfanın özeti olarak yine geçen seferki mantıkla ama bu sefer

tarih............................tutarı stununun sayısı................................problem sütununun sayısı

01/08/2013.................................25 .....................................................2

gibi.

Amaç bir gün içerisinde kesilen faturaların sipariş hazırlama ve gönderme süreceinde karşılaşılan hata ve problem var ise toplam fatura sayısına oranını bulmak ve genel sayfasındada aylık olarak toplam hatalı faturanın toplam kesilen fatura oranını bulmak.

Biliyorum bunlar saçma şeyler ama istiyorlar :)

kodlara hiç dokunmadım en son sizin yazdığınız kodlar ben sadece sayfalar üzerinde şablon değiştirdim.

dosyalar ektedir.

Ben uğraştım ama tek bir değişiklik bile yapamadım hep hata aldım.

Yardımınızı rica ederim.

İyi Çalışmalar
 

Ekli dosyalar

Son düzenleme:
Haliy bey son gönderdiğim mesaj ile ilgili yardımcı olabilecek misiniz?

Zaten sizin yadığınız kodlar. Sadece bir kaç yerinde değişiklik yapılacak.

Denetleme var zamanım daralıyor. Yardımcı olusanız sevinirim.

İyi Çalışmalar.
 
Haliy bey son gönderdiğim mesaj ile ilgili yardımcı olabilecek misiniz?

Zaten sizin yadığınız kodlar. Sadece bir kaç yerinde değişiklik yapılacak.

Denetleme var zamanım daralıyor. Yardımcı olusanız sevinirim.

İyi Çalışmalar.

Merhaba

Ben sorunuza bu şekliyle cevap vermiyorum çünkü sorunuzu anlamıyorum.
Örnek dosyanızda olması gereken verileri elle manuel olarak girin ve ekleyin ondan sonra bakalım bunun dışındaki sorunuza cevap vermiyeceğim

Eğer örnek dosyanıza olması gereken verileri siz manuel eklemezseniz ben bu konuda cevap yazmıyacağım.

İyi çalışmalar.
 
Halit bey 27.mesajı güncelledim.

sizin dediğiniz gibi doldurdum.

Kolay gelsin.
 
Halit bey 27.mesajı güncelledim.

sizin dediğiniz gibi doldurdum.

Kolay gelsin.

Şablon2 dosyasındaki VERİ ÇEKME_AKTARMA sayfasındaki E,F,G sütunlarındaki veriler nereden geliyor.

Yani örnek E10,F10,G10 hücrelerindeki veriler nerden geliyor.
 
Şablon2 dosyasındaki VERİ ÇEKME_AKTARMA sayfasındaki E,F,G sütunlarındaki veriler nereden geliyor.

Yani örnek E10,F10,G10 hücrelerindeki veriler nerden geliyor.

Özür Dilerim unuttum söylemeyi.

Onları ben elimle manuel dolduruyorum.

Problem çıkan faturaların karşısını dolduruyorum sadece, kimi gün bomboş da olabilir.

Kolay gelsin
 
Özür Dilerim unuttum söylemeyi.

Onları ben elimle manuel dolduruyorum.

Problem çıkan faturaların karşısını dolduruyorum sadece, kimi gün bomboş da olabilir.

Kolay gelsin

Kod:

Kod:
Private Sub CommandButton1_Click()
Range("A3:D65000").ClearContents
Kalasor = ThisWorkbook.Path
dosya = "veri1.xls"
SayfaAdi = "Sayfa1"
deg = "'" & Kalasor & "\" & "[" & dosya & "]" & SayfaAdi & "'!R"
sat = Application.ExecuteExcel4Macro("COUNTA('" & Kalasor & "\" & "[" & dosya & "]" & SayfaAdi & "'!R1C1:R65000C1)")
For i = 3 To sat
Cells(i, "a").Value = CDate(ExecuteExcel4Macro(deg & i & "C5")) ' E sutunu
Cells(i, "b").Value = ExecuteExcel4Macro(deg & i & "C2")        ' B sutunu
Cells(i, "c").Value = ExecuteExcel4Macro(deg & i & "C6")        ' F sutunu
Cells(i, "d").Value = ExecuteExcel4Macro(deg & i & "C12")       ' L sutunu
If Cells(i, "d").Value = 0 Then Cells(i, "d").Value = ""
Next i

Cells(1, "E").Value = WorksheetFunction.CountA(Range("e3:e1000"))
Cells(1, "D").Value = WorksheetFunction.Count(Range("D3:D1000"))

MsgBox "işlem tamam"

End Sub


Kod:
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sayfa_Adı = ActiveSheet.Name
son1 = Sheets(Sayfa_Adı).[a65000].End(3).Row
son2 = Sheets("GENEL").[a65000].End(3).Row + 1

yeni_sayfa = Format(Sheets(Sayfa_Adı).Cells(3, 1).Value, "dd-mm-yyyy")


For i = 1 To Sheets.Count
If Sheets(i).Name = yeni_sayfa Then
MsgBox yeni_sayfa & Chr(10) & "Bu sayfa adına daha önceden kayıt yapıldı"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
End If
Next i

Sheets(Sayfa_Adı).Range("A1:G" & son1).Copy
Sheets.Add
Sheets(ActiveSheet.Name).Range("A1").Select
Sheets(ActiveSheet.Name).Paste
Sheets(ActiveSheet.Name).Name = yeni_sayfa
Sheets(yeni_sayfa).Move After:=Sheets(Sheets.Count)
Sheets(yeni_sayfa).Columns("A:G").EntireColumn.AutoFit
Sheets(yeni_sayfa).Range("A1").Select

MsgBox 1
Sheets("GENEL").Cells(son2, "a").Value = Sheets(Sayfa_Adı).Cells(3, "a").Value
Sheets("GENEL").Cells(son2, "b").Value = Sheets(Sayfa_Adı).Cells(1, "d").Value
Sheets("GENEL").Cells(son2, "c").Value = Sheets(Sayfa_Adı).Cells(1, "e").Value
Sheets("GENEL").Cells(son2, "D").Value = 1 - (Sheets(Sayfa_Adı).Cells(1, "e").Value / Sheets(Sayfa_Adı).Cells(1, "D").Value)

Sheets(Sayfa_Adı).Select
Sheets(Sayfa_Adı).Range("A1").Select
Application.CutCopyMode = False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "işlem tamam"


End Sub
 
Halit bey çok teşekkür ediyorum. Çalışıyor.

Arada bir yoruyorum sizi. Hakkınızı helal edin.

Sayenizde bir sürü yükün altından kurtuluyorum. Allah sizin de yükünüzü hafifletir inşallah.

Ayrıca cevaplama hızınız süper. Buna ayrıca tşk.

İyi Çalışmalar.
 
Halit bey küçük bir düzeltme rica edebilir miyim.

yeni sayfa açıp aktarırken biçimler bozulmasa.

oluşturulan sayfada yeniden biçim ayarı yapmak gerekiyor. Sütun genişlikleri falan.

Tşk.
 
Halit bey küçük bir düzeltme rica edebilir miyim.

yeni sayfa açıp aktarırken biçimler bozulmasa.

oluşturulan sayfada yeniden biçim ayarı yapmak gerekiyor. Sütun genişlikleri falan.

Tşk.

kod:

Kod:
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sayfa_Adı = ActiveSheet.Name
son1 = Sheets(Sayfa_Adı).[a65000].End(3).Row
son2 = Sheets("GENEL").[a65000].End(3).Row + 1

yeni_sayfa = Format(Sheets(Sayfa_Adı).Cells(3, 1).Value, "dd-mm-yyyy")


For i = 1 To Sheets.Count
If Sheets(i).Name = yeni_sayfa Then
MsgBox yeni_sayfa & Chr(10) & "Bu sayfa adına daha önceden kayıt yapıldı"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
End If
Next i

Sheets(Sayfa_Adı).Range("A1:G" & son1).Copy
Sheets.Add

Sheets(ActiveSheet.Name).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets(ActiveSheet.Name).Name = yeni_sayfa
Sheets(yeni_sayfa).Move After:=Sheets(Sheets.Count)

Sheets(yeni_sayfa).Range("A1").Select

Sheets("GENEL").Cells(son2, "a").Value = Sheets(Sayfa_Adı).Cells(3, "a").Value
Sheets("GENEL").Cells(son2, "b").Value = Sheets(Sayfa_Adı).Cells(1, "d").Value
Sheets("GENEL").Cells(son2, "c").Value = Sheets(Sayfa_Adı).Cells(1, "e").Value
Sheets("GENEL").Cells(son2, "D").Value = 1 - (Sheets(Sayfa_Adı).Cells(1, "e").Value / Sheets(Sayfa_Adı).Cells(1, "D").Value)

Sheets(Sayfa_Adı).Select
Sheets(Sayfa_Adı).Range("A1").Select
Application.CutCopyMode = False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "işlem tamam"


End Sub
 
Geri
Üst