Veri Aktarma Hatası

[emiroglu07]

Üstadlar merhaba elimdeki excel dosyasında tekne sayfasından rapor sayfasına aktarma yapmak istiyorum ama yapamadım.
konu hakkında yardımcı olabilirmisiniz.
Aktarım yapılacak rapor sayfasındaki verilerin karşılığı olacak şekilde nasıl yapılabilir.

İndir 444

Dosyayı indir 444

dosya.co

örnek dosyam ektedir şimdiden yardımlarınız için çok teşekkür ederim

 

[emiroglu07]

Üstadlar nasıl bir makro kullanabilirim acaba

 

[YUSUF44]

Aşağıdaki makroyu dener misiniz?

Sub teknerapor()
Set s1 = Sheets("TEKNE")
Set s2 = Sheets("TRAPOR")
s2.[A10:A1209].ClearContents
s2.[C10:M1209].ClearContents
son = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "A").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select distinct [TEKNE ADI] from [TEKNE$A6:J" & son & "] where [TEKNE ADI] is not null"
Set rs = con.Execute(sorgu)

s2.[N1].CopyFromRecordset rs
sonN = s2.Cells(Rows.Count, "N").End(3).Row
sat = 10
Application.ScreenUpdating = False
    For tekne = 1 To sonN
        s2.Cells(sat, "A") = s2.Cells(tekne, "N")
        For kisi = 3 To 11 Step 4
            For doviz = sat To sat + 3
                s2.Cells(doviz, kisi) = WorksheetFunction.SumIfs(s1.Range("E6:E" & son), s1.Range("B6:B" & son), s2.Cells(tekne, "N"), _
                                        s1.Range("C6:C" & son), s2.Cells(9, kisi), s1.Range("D6:D" & son), s2.Cells(8, kisi), _
                                        s1.Range("F6:F" & son), s2.Cells(doviz, "B"))
                
                s2.Cells(doviz, kisi + 1) = WorksheetFunction.SumIfs(s1.Range("E6:E" & son), s1.Range("B6:B" & son), s2.Cells(tekne, "N"), _
                                        s1.Range("C6:C" & son), s2.Cells(9, kisi + 1), s1.Range("D6:D" & son), s2.Cells(8, kisi), _
                                        s1.Range("F6:F" & son), s2.Cells(doviz, "B"))
                s2.Cells(doviz, kisi + 2) = s2.Cells(doviz, kisi) - s2.Cells(doviz, kisi + 1)
            Next
        Next
        sat = sat + 4
    Next
Application.ScreenUpdating = True
End Sub

 

[muygun]

Merhaba;
Ekteki gibi olabilir.
Deneyin.
İyi çalışmalar.

Not: Veri doğruluğunu kontrol edin.

Link:
https://s7.dosya.tc/server23/a0qfv4/emiroglu07-444.zip.html

 

[emiroglu07]

Hiç umudum yokken yardıma yetiştiniz Allah razı olsun sizden Rabbim Ayağınıza taş değdirmesin.
Ellerinize sağlık üstadlarım Rabbim işleriniz rast yolunda getirsin.

 

[YUSUF44]

Benim verdiğim kodları kullandıysanız End sub satırından önce aşağıdaki satırı ekleyin ki N sütunundaki geçici veriler silinsin:

s2.Range("N1:N" & sonN).ClearContents

 

[YUSUF44]

Ayrıca TRAPOR sayfasının üst bölümündeki özet kısmı için aşağıdaki işlemleri yapabilirsiniz:

B3 hücresine aşağıdaki formülü yapıştırın ve sonra bu hücreyi kopyalayıp B3:E5 arasına formül olarak yapıştırın (isterseniz doğrudan yapıştırabilirsiniz ama bu durumda çerçeve ayarlarını yapmanız gerekir):

=ÇOKETOPLA(Tablo14[TUTAR];Tablo14[DÖVİZ CİNSİ];B$2;Tablo14[İŞLEMİ YAPAN];$A3;Tablo14[İŞLEM TÜRÜ];$B$1)

F3 hücresine aşağıdaki formülü yapıştırın ve sonra bu hücreyi kopyalayıp F3:I5 arasına formül olarak yapıştırın (isterseniz doğrudan yapıştırabilirsiniz ama bu durumda çerçeve ayarlarını yapmanız gerekir):

=ÇOKETOPLA(Tablo14[TUTAR];Tablo14[DÖVİZ CİNSİ];F$2;Tablo14[İŞLEMİ YAPAN];$A3;Tablo14[İŞLEM TÜRÜ];$F$1)

J3 hücresine aşağıdaki formülü yapıştırın ve sonra bu hücreyi kopyalayıp J3:M5 arasına formül olarak yapıştırın (isterseniz doğrudan yapıştırabilirsiniz ama bu durumda çerçeve ayarlarını yapmanız gerekir):

=B3-F3

Bu formüller doğrudan TEKNE sayfasındaki tablodan verileri alacağı için sürekli güncel olarak sonuç verir. Yeni veri eklendiğinde de sonuca yansır.

 

[emiroglu07]

Teşekkür ederim üstad hemen deneyeceğim
birde üstad

Sub kayıtlarıal()
Dim kayıtsayısı, Satır As Variant
ListBox1.Clear
kayıtsayısı = Sheets("TRAPOR").Cells(Rows.Count, "A").End(xlUp).Row
For Satır = 2 To kayıtsayısı
    If InStr(Sheets("TRAPOR").Range("A" & Satır), TextBox1.Value) > 0 Then
ListBox1.AddItem Sheets("TRAPOR").Range("A" & Satır)
    End If
Next Satır
 End Sub

Private Sub ListBox1_Click()
ActiveCell.Value = ListBox1.Value
End Sub

Kullanmış olduğum bu kodun extre sayfasında sadece b1 hücresine veri aktarmasını istiyorum ama beceremedim bi türlü nasıl işlem yapıla bilir

 

[YUSUF44]

Eğer o an extre sayfası açıksa activecell yerine [B1] yazabilirsiniz. Başka sayfadaysanız Sheets("extre").[B1] olmalı.

 

[emiroglu07]

Vallahi üstadsınız bu işte bu kadar basitmiydi çok teşekkür ederim .
Rabbim işlerinizi rast getirsin.

 

[YUSUF44]

Üstadlık kim ben kim, üstadların bildiğinin sadakası bile beni ihya eder.