Döngü İle Excele Veri Aktarmak

1 2 3

Merhaba Excel kitabı içerisinde tablo içerisindeki bir sütunda bulunan veriler ile sayfalar oluşturuyorum.
Bir sorgu içerisindeki koşula uygun olanlar ile gecici tablolar oluşturturuyorum.
Bu oluşturttuğum geçici tablolardan sırasıyla Excel kitabındaki sayfalara başka verileri aktarmak istiyorum. Bir türlü beceremedim çalışma falan herşeyi sildim Nerede hata yapıyorum veya Daha iyi bir önerisi olan var mı

Kod:
    DoCmd.SetWarnings False

        If MsgBox("Bilgileriniz Excele Aktarılsın mı?", vbCritical + vbYesNo + vbDefaultButton1, "UYARI") = vbNo Then Exit Sub

        MsgBox "Aktarma İşlemi BİP sesini Duyana Kadar Devam Edecektir Excel Açıldıktan Sonra Hücrelere Tıklarsanız Eksik veya Hatalı Aktarabilir. Bilgisayarınızın Sesi Açık Olduğundan Emin Olunuz.", vbDefaultButton1, "UYARI!!!"

Dim rs As Excel.Application

Dim KTP1 As Excel.Workbook

Dim SYF As Excel.Worksheet

Set Excl = New Excel.Application

With Excl

      .Application.Visible = True

      .UserControl = True

End With

        Set KTP1 = Excl.Workbooks.Open(CurrentProject.Path & "\EXCEL TABLOLARI\Malzemeci.xlsx")

        Set Rs1 = CurrentDb.OpenRecordset("Alinan_Malzeme_Giris")

        Set Rs3 = CurrentDb.OpenRecordset("Alinan_Malzeme_Giris")

 '################### gecici tablo oluşturma #########################

  Dim ğ

        ğ = 1

        Do Until Rs3.EOF

        Me.Metin1 = Rs1(2)

DoCmd.RunSQL "SELECT srg_Malzemeci_Cizelgesi.Harcanan_ID, srg_Malzemeci_Cizelgesi.Malzeme_Miktari, srg_Malzemeci_Cizelgesi.Malzeme_Markasi, srg_Malzemeci_Cizelgesi.Malzeme_Adi, srg_Malzemeci_Cizelgesi.Malzeme_Seri_No, srg_Malzemeci_Cizelgesi.Sorusturma, srg_Malzemeci_Cizelgesi.Malzeme_Alindigi_Tarih, srg_Malzemeci_Cizelgesi.TSG, srg_Malzemeci_Cizelgesi.Adi_Soyadi, srg_Malzemeci_Cizelgesi.Sahis_Adi_Soyadi INTO gecici_malzemeci" & ğ & " FROM srg_Malzemeci_Cizelgesi WHERE (((srg_Malzemeci_Cizelgesi.Malzeme_Adi)=IIf([Formlar]![frm_excel]![Metin1]='(Hepsi)',[Malzeme_Adi],[Formlar]![frm_excel]![Metin1])))"

ğ = ğ + 1

Rs3.MoveNext

            Loop

Rs3.Close

  Dim ş

        ş = 1

        Do Until Rs1.EOF

        Me.Metin1 = Rs1(2)

Set Rs2 = CurrentDb.OpenRecordset("gecici_malzemeci" & ş)

            SyfAdi = Rs1(1) & " " & Rs1(2)

            SyfAdiTmp = SyfAdi

            SyfNo = 0

            Do While WorksheetExists(SyfAdiTmp, KTP1) = True

            SyfNo = SyfNo + 1

            SyfAdiTmp = SyfAdi & IIf(SyfNo = 0, "", "(" & SyfNo & ")")

            Loop

            Excl.Sheets.Add.Name = SyfAdiTmp

'BAŞLIKLAR

Excl.Range("A" & ş) = Rs1(1) & " " & Rs1(2)

Excl.Range("A" & ş + 1) = "V.MİKTAR"

Excl.Range("C" & ş + 1) = "K.MİKTAR"

Excl.Range("E" & ş + 1) = "KULLANILAN MİKTAR"

Excl.Range("A" & ş + 2) = "SIRA NO"

Excl.Range("B" & ş + 2) = "ADET"

Excl.Range("C" & ş + 2) = "MARKASI"

Excl.Range("D" & ş + 2) = "BOYUT"

Excl.Range("E" & ş + 2) = "SERİ NO"

Excl.Range("F" & ş + 2) = "SORUŞTURMA NO"

Excl.Range("G" & ş + 2) = "TESLİM TARİHİ"

Excl.Range("H" & ş + 2) = "KULLANILMA TARİHİ"

Excl.Range("I" & ş + 2) = "KULLANAN PERSONEL"

Excl.Range("J" & ş + 2) = "KULLANILAN ŞAHIS"

Rs1.MoveNext

 Loop

i = 1

  Do Until Rs2.EOF

  Excl.Sheets(SyfAdiTmp).Select

  Excl.Cells(i + 3, "A") = Rs2(1)

  i = i + 1

Rs2.MoveNext

  Loop

Rs2.Close

DoCmd.RunMacro "Makro2" 'işlem bitince BİOS sesi Uyarı BİP

    Excl.Visible = True

  Set Excl = Nothing

    DoCmd.SetWarnings True

End Sub

örnek çalışmanızı ekleyip örnek üzerinden açıklama yaparsanız çözüme ulaşma ihtimali artar

(15/10/2021, 18:16)berduş yazdı: örnek çalışmanızı ekleyip örnek üzerinden açıklama yaparsanız çözüme ulaşma ihtimali artar

Bir örnek hazırlamaya çalışacağım.

Hata aldığım kısım
Set rs2 nin bağlandığı tabloyu döngü içerisinde kullanmak istediğimde hata alıyorum.

Örnek bir çalışma ekledim.

Yapmak istediğimden kısaca bahsedeyim

Devre dışı bıraktığım kodlardaki döngüyle oluşturttuğum tablolardaki verileri oluşturttuğum sayfalara aktarmasını istiyorum. Nasıl olacağını bilemedim.
ADO ile yapılabilir mi daha basit bir yöntem onu da bilmiyorum.

2 tabloyu birleştirdiğimde şöyle bir tablo oluşuyor
kriter formdaki metin kutusu galiba
metin kutusun ne yazıp butona basınca excele hangi veriler nasıl nasıl aktarılacak?

Metğn kutusuna alınan malzeme giriş tablosundaki Alınan_ID değerleri döngü arcılığıyla sırayla yazılıyor.

Excele; Alına malzeme girişdeki malzeme adlarında sayfalar oluşturulacak ve bu sayfalara tablo1 deki Alınan_ID ilişkisine göre aktarım yapacak

1 2 3

Döngü İle Excele Veri Aktarmak

lemoncher2

berduş

lemoncher2

lemoncher2

berduş

lemoncher2