• 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...

Katılım
18 Mart 2012
Mesajlar
440
Excel Vers. ve Dili
2013
Merhabalar

Ekte 2 adet dosya gönderiyorum. ŞABLON isimli dosyayı açarsanız istediklerim içerisinde yazıyor.
Kodlamayı bilenler için çok kolay bir problem ama zahmetli olabilir.

Zahmetlerini esirgemeyen arkadaşlara çok teşekkür ederim.

Yardımlarınızı rica ediyorum.

Herkese iyi Çalışmalar.
 

Ekli dosyalar

Son düzenleme:
Arkadaşlar tamam benzer bi sürü konu var ama bütün bunları kendi çalışmama uyarlayamıyorum. VBA temelim yok.

Biraz birşeyler bilsem tamam ama yok :) ben uğraşsam 2 ayımı alır.

Bilen arkadaşlardan ricamdır. Konuya bir el atalım lütfen.
 
veri isimli kitaptan şablon isimli kitaptaki tabloya veri alınacak. Bu tablo aynı kitapta yeni bir sayfa açtırılıp isim verdirilip oraya kaydettirilecek.

yardımlarınızı bekliyorum.
 
Çalışmanın komplesi uzun oldu galiba en iyisi parça parça yardım alıp birleştirmek.


Mevcut çalışma sayfasındaki A2:E35 ARALIĞINI yeni bir çalışma sayfası açıp A:2 deki ismi vererek kopyasını oluşturacak bir kod rica ederim.
 
ŞABLON.xlsx dosyanız 2003 sürümü ile açılmıyor.
 
Selam,

2003 e çevirip tekrar gönderiyorum. 1. mesajı güncelledim.

Teşekkürler.
 
Dosyanıza baktım veri nasıl alınacak anlıyamadım örnek dosyanızdaki şablon sayfasına veri1 dosyasından almak istediğiniz verileri manuel olarak ekleyin ne demek istediğinizi anlıyalım.

Zira şablon sayfasında H2 hücresinde 03.08.2013 yazıyor veri1 dosyanızda bu tarih yok
 
Dosyanıza baktım veri nasıl alınacak anlıyamadım örnek dosyanızdaki şablon sayfasına veri1 dosyasından almak istediğiniz verileri manuel olarak ekleyin ne demek istediğinizi anlıyalım.

Zira şablon sayfasında H2 hücresinde 03.08.2013 yazıyor veri1 dosyanızda bu tarih yok

Halit bey ilgilendiğiniz için teşekkür ederim.

o tarihi teslimat tarihini belirlemek için biz dolduracaz. Her gün için manuel girilecek. Veri1 dosyasındaki veriler karmaşık ve sırasız. İstediğim bilgileri istediğim sıraya Şablon1 dosyasına çekmek istiyorum.

Ekte iki adet dosya var. Şablon1 isimli çalışma kitabına Veri1 çalışma kitabından veri çekilecek.

Neden veri1 çalışma kitabından diye soracak olursanız; bu dosyanın içeriği sürekli değişecek. Logo dan dışarıya veri atıp bu dosya üzerine kaydedicem.
Yani veri1 Kitabındaki bilgiler değişken olacak (Satı ve sütun yerleri standart değişmeyecek sadece veriler değişecek)

Veri1 çalışma kitabından Şablon1 Çalışma kitabına çektiğim veriyi gün gün sınıflayarak anlamlı bilgiler elde etmeyi düşünüyorum.

Firmanın biri denetlemede böyle bir rapor istedi. Ürün teslimat süresi gününü aylık ortalaması için. Genelde firmalar böyle saçma raporlar isterler. Gün gün fatura kesilen müşteri ve teslimat tarihi ve süresini bir rapor halinde isterler.

Eğer anlatamamış isem tekrar sorabilirsiniz Halit bey.

İyi Çalışmalar
 
Halit bey ilgilendiğiniz için teşekkür ederim.

o tarihi teslimat tarihini belirlemek için biz dolduracaz. Her gün için manuel girilecek. Veri1 dosyasındaki veriler karmaşık ve sırasız. İstediğim bilgileri istediğim sıraya Şablon1 dosyasına çekmek istiyorum.

Ekte iki adet dosya var. Şablon1 isimli çalışma kitabına Veri1 çalışma kitabından veri çekilecek.

Neden veri1 çalışma kitabından diye soracak olursanız; bu dosyanın içeriği sürekli değişecek. Logo dan dışarıya veri atıp bu dosya üzerine kaydedicem.
Yani veri1 Kitabındaki bilgiler değişken olacak (Satı ve sütun yerleri standart değişmeyecek sadece veriler değişecek)

Veri1 çalışma kitabından Şablon1 Çalışma kitabına çektiğim veriyi gün gün sınıflayarak anlamlı bilgiler elde etmeyi düşünüyorum.

Firmanın biri denetlemede böyle bir rapor istedi. Ürün teslimat süresi gününü aylık ortalaması için. Genelde firmalar böyle saçma raporlar isterler. Gün gün fatura kesilen müşteri ve teslimat tarihi ve süresini bir rapor halinde isterler.

Eğer anlatamamış isem tekrar sorabilirsiniz Halit bey.

İyi Çalışmalar

Benim söylediğim başka bir şeydi siz başka anlatıyorsunuz.

veri1 dosyasındaki verileri Şablon dosyasına manuel alın demiştim o zaman alınan verileri görürüz

kod:

Kod:
Sub kapalıverial()
Kalasor = ThisWorkbook.Path
dosya = "veri1.xls"
SayfaAdi = "Sayfa1"
deg = "'" & Kalasor & "\" & "[" & dosya & "]" & SayfaAdi & "'!R"
sat = Application.ExecuteExcel4Macro("COUNTA('" & Kalasor & "\" & "[" & dosya & "]" & SayfaAdi & "'!C2)")
'sut = Application.ExecuteExcel4Macro("COUNTA('" & Kalasor & "\" & "[" & Dosya & "]" & sayfaadi & "'!R1)")
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
Next i
MsgBox "işlem tamam"
End Sub

not: İki dosyada aynı yerde olacak
 
Halit bey veri alma tamam

ama ufak bir sorun var, bir döngü var ve hiç bitmiyor sanırım. Excel yanıt vermiyor diyor sonunda. Pürüz giderilirse ikici aşamaya geçebilirmiyiz.

Kodu uyguladığım dosyaları tekrar gönderiyorum.

İyi Çalışmalar.
 

Ekli dosyalar

Kod buraya eklemiş olduğun dosyada bende çalışıyor hata vermiyor.

Bu kod veri1 dosyasındaki son satır numarasını mesaj ile gösteriyor bendeki mesaj 18 olarak gösteriyor.

kod:

Kod:
Private Sub CommandButton1_Click()
Range("A3:E65000").ClearContents

Kalasor = ThisWorkbook.Path
dosya = "veri1.xls"
SayfaAdi = "Sayfa1"
deg = "'" & Kalasor & "\" & "[" & dosya & "]" & SayfaAdi & "'!R"
sat = Application.ExecuteExcel4Macro("COUNTA('" & Kalasor & "\" & "[" & dosya & "]" & SayfaAdi & "'!C2)")
'sut = Application.ExecuteExcel4Macro("COUNTA('" & Kalasor & "\" & "[" & Dosya & "]" & sayfaadi & "'!R1)")
MsgBox sat
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 = Cells(2, "h").Value
Cells(i, "e").Value = Cells(i, "d").Value - Cells(i, "a").Value
Next i
MsgBox "işlem tamam"
End Sub
 
Halit bey selam,

Bu koduda denedim. Çalıştırınca veri1 dosyasının yerini soruyor dosyayı bulup aç dediğimde ilk sütuna veriyi yazıyor ve tekrar dosyanın yerini soruyor. Her sormasında ve dosyayı bulup aç dememde sıradaki hücreyi dolduruyor.

Komutu durdurana kadar devam ediyor bu durum.

Bana sormadan kendi bulup veriyi alıp yazıp bitirse olmaz mı?

İyi Çalışmalar
 
Halit bey selam,

Bu koduda denedim. Çalıştırınca veri1 dosyasının yerini soruyor dosyayı bulup aç dediğimde ilk sütuna veriyi yazıyor ve tekrar dosyanın yerini soruyor. Her sormasında ve dosyayı bulup aç dememde sıradaki hücreyi dolduruyor.

Komutu durdurana kadar devam ediyor bu durum.

Bana sormadan kendi bulup veriyi alıp yazıp bitirse olmaz mı?

İyi Çalışmalar


not :Her iki dosyada aynı yerde yan yana olacak

kod:

Kod:
Private Sub CommandButton2_Click()
Kalasor = ThisWorkbook.Path
dosya = "veri1.xls"
SayfaAdi = "Sayfa1"
deg3 = Cells(1, 6).Value
kap_dos_sütün_no = "A" 'Cells(1, 6).Value '"A" 'veri alınacak kapalı dosyanın son dolu satırıma ait sutun adı
sonsat = 65000          'Rows.Count - 1
kap_dos_satir_no = 1    'veri alınacak kapalı dosyanın son dolu sütununa ait satır numarası
bas_satir_no = 3        'aktarılacak veriye ait başlangıç satır numarası
deg1 = Kalasor & "\" & "[" & dosya & "]" & SayfaAdi
yer2 = "LOOKUP(2,1/('" & deg1 & "'!" & kap_dos_sütün_no & "1:" & kap_dos_sütün_no & sonsat & "<>""""),ROW('" & deg1 & "'!" & kap_dos_sütün_no & ":" & kap_dos_sütün_no & "))"
Cells(1, 6).Value = "=IF(ISERROR(" & yer2 & "),""""," & yer2 & ")"
sat = Cells(1, 6).Value
deg2 = "'" & deg1 & "'!R"
For i = 3 To sat
Cells(i, "a").Value = CDate(ExecuteExcel4Macro(deg2 & i & "C5")) ' E sutunu
Cells(i, "b").Value = ExecuteExcel4Macro(deg2 & i & "C2")        ' B sutunu
Cells(i, "c").Value = ExecuteExcel4Macro(deg2 & i & "C6")        ' F sutunu
Cells(i, "d").Value = Cells(2, "h").Value
Cells(i, "e").Value = Cells(i, "d").Value - Cells(i, "a").Value
Next i
Cells(1, 6).Value = deg3
MsgBox "işlem tamam"
End Sub
 
Halit bey bu kod sizde sorunsuz çalışıyor mu.

İlk gönderdiğiniz kod çalışmıştı ama kilitlenip kalıyordu.

son gönderdikleriniz dosya aç şeklinde pencere açıyor. veri1 ve ŞABLON1 aynı klasörde.

sizi de oyalıyorum. Hakkınızı helal edin.
 
Halit bey bu kod sizde sorunsuz çalışıyor mu.

İlk gönderdiğiniz kod çalışmıştı ama kilitlenip kalıyordu.

son gönderdikleriniz dosya aç şeklinde pencere açıyor. veri1 ve ŞABLON1 aynı klasörde.

sizi de oyalıyorum. Hakkınızı helal edin.

bu video ofis 2003 için
görsel video

bu video ofis 2007 için

görsel video


kodlar:

Kod:
Private Sub CommandButton1_Click()
Range("A3:E65000").ClearContents

Kalasor = ThisWorkbook.Path
dosya = "veri1.xls"
SayfaAdi = "Sayfa1"
deg = "'" & Kalasor & "\" & "[" & dosya & "]" & SayfaAdi & "'!R"
sat = Application.ExecuteExcel4Macro("COUNTA('" & Kalasor & "\" & "[" & dosya & "]" & SayfaAdi & "'!C2)")
'sut = Application.ExecuteExcel4Macro("COUNTA('" & Kalasor & "\" & "[" & Dosya & "]" & sayfaadi & "'!R1)")

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 = Cells(2, "h").Value
Cells(i, "e").Value = Cells(i, "d").Value - Cells(i, "a").Value
Next i
MsgBox "işlem tamam"
End Sub

kod2:

Kod:
Private Sub CommandButton3_Click()
Kalasor = ThisWorkbook.Path
dosya = "veri1.xls"
SayfaAdi = "Sayfa1"
deg3 = Cells(1, 6).Value
kap_dos_sütün_no = "A" 'Cells(1, 6).Value '"A" 'veri alınacak kapalı dosyanın son dolu satırıma ait sutun adı
sonsat = 65000          'Rows.Count - 1
kap_dos_satir_no = 1    'veri alınacak kapalı dosyanın son dolu sütununa ait satır numarası
bas_satir_no = 3        'aktarılacak veriye ait başlangıç satır numarası
deg1 = Kalasor & "\" & "[" & dosya & "]" & SayfaAdi
yer2 = "LOOKUP(2,1/('" & deg1 & "'!" & kap_dos_sütün_no & "1:" & kap_dos_sütün_no & sonsat & "<>""""),ROW('" & deg1 & "'!" & kap_dos_sütün_no & ":" & kap_dos_sütün_no & "))"
Cells(1, 6).Value = "=IF(ISERROR(" & yer2 & "),""""," & yer2 & ")"
Cells(1, 6).Value = Cells(1, 6).Value
sat = Cells(1, 6).Value

deg2 = "'" & deg1 & "'!R"
For i = 3 To sat
Cells(i, "a").Value = CDate(ExecuteExcel4Macro(deg2 & i & "C5")) ' E sutunu
Cells(i, "b").Value = ExecuteExcel4Macro(deg2 & i & "C2")        ' B sutunu
Cells(i, "c").Value = ExecuteExcel4Macro(deg2 & i & "C6")        ' F sutunu
Cells(i, "d").Value = Cells(2, "h").Value
Cells(i, "e").Value = Cells(i, "d").Value - Cells(i, "a").Value
Next i
Cells(1, 6).Value = deg3
MsgBox "işlem tamam"
End Sub
 
Bu kod hepsinde çalışıyor

Kod:
Private Sub CommandButton1_Click()
Range("A3:E65000").ClearContents
Kalasor = ThisWorkbook.Path
dosya = "veri1.xls"
SayfaAdi = "Sayfa1"
deg = "'" & Kalasor & "\" & "[" & dosya & "]" & SayfaAdi & "'!R"
'sat = Application.ExecuteExcel4Macro("COUNTA('" & Kalasor & "\" & "[" & dosya & "]" & SayfaAdi & "'!C2)")
sat = Application.ExecuteExcel4Macro("COUNTA('" & Kalasor & "\" & "[" & dosya & "]" & SayfaAdi & "'!R1C1:R65000C1)")
'sut = Application.ExecuteExcel4Macro("COUNTA('" & Kalasor & "\" & "[" & Dosya & "]" & sayfaadi & "'!R1)")
'MsgBox sat
'Exit Sub
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 = Cells(2, "h").Value
Cells(i, "e").Value = Cells(i, "d").Value - Cells(i, "a").Value
Next i
MsgBox "işlem tamam"
End Sub
 
Selam,

Halit bey bu seferki hatasız çalıştı. Teşekkür ederim.

Şimdi bu hazırladığımız düzenli veriyi aynı çalışma kitabında butona tıkladığımızda yeni bir sayfa oluşturarak (sayfa ismi tarih olacak) içine kopyalayabilir miyiz.

İyi Çalışmalar.
 
Selam,

Halit bey bu seferki hatasız çalıştı. Teşekkür ederim.

Şimdi bu hazırladığımız düzenli veriyi aynı çalışma kitabında butona tıkladığımızda yeni bir sayfa oluşturarak (sayfa ismi tarih olacak) içine kopyalayabilir miyiz.

İyi Çalışmalar.

Ben aslında cevap vermekten kaçınıyorum sorularınız eksik oluyor çünkü sayfa ismi tarih olacak diyorsunuz tarihi nereden alacak kod ?


ben sayfa ismini A3 hücresindeki tarihten aldırdım.

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ı).[COLOR="Red"]Cells(3, 1).Value[/COLOR], "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:E" & son).Copy
If ekle = 0 Then
Sheets.Add
Range("a2").Select
ActiveSheet.Paste
Sheets(ActiveSheet.Name).Name = yeni_sayfa
Columns("A:E").Select
Columns("A:E").EntireColumn.AutoFit
Else
Sheets(yeni_sayfa).Select
son2 = Sheets(yeni_sayfa).[a65000].End(3).Row + 1
Range("a" & son2).Select
ActiveSheet.Paste
End If


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
 
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.
 
Geri
Üst