verileri sayfalara göre kategorize etme

[manda]

Öncelikle Site sakinlerine hayırlı ramazanlar.
Sorunumu ekte ki dosyada belirttim yardımcı olursanız sewinirim .

 

[hamitcan]

Sub Aktar()
Dim arr()
SIL
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> "TOPTAN" Then
        x = x + 1
        ReDim Preserve arr(1 To x)
        arr(x) = Sheets(i).Name
        End If
    Next
    For k = 2 To [A65536].End(3).Row
        For j = 1 To UBound(arr)
            If arr(j) = Trim(Cells(k, 3)) Then
            d = Sheets(arr(j)).[A65536].End(3).Row + 1
            Sheets(arr(j)).Range("a" & d & ":" & "j" & d) = Sheets("TOPTAN").Range("a" & k & ":" & "j" & k).Value
            End If
        Next
    Next
MsgBox "Bitti."
End Sub
Sub SIL()
For i = 1 To Sheets.Count
If Sheets(i).Name <> "TOPTAN" Then
Sheets(i).[a4:j1000].ClearContents
End If
Next
End Sub

 

[manda]

pardon ben bu kodları nereye yazacağım

 

[İhsan Tank]

pardon ben bu kodları nereye yazacağım

merhaba
sanırım Hamitcan hocam yok
boş bir module kopyalayın ve deneyin

 

[manda]

denedim ama olmuyor sebebi nedir module kopyalıyorum vba sayfasını kapatıyorum ama olmuyor

 

[İhsan Tank]

denedim ama olmuyor sebebi nedir module kopyalıyorum vba sayfasını kapatıyorum ama olmuyor

buton'a atamayı unuttunuz sanırım
buyrun ayrıntı burada

 

[manda]

sayın ihsan bey şu kod ları bana porgram içinde gönderirmisin

 

[İhsan Tank]

sayın ihsan bey şu kod ları bana porgram içinde gönderirmisin

onu yapamam çünkü biraz da sizin çaba sarfetmeniz gerekiyor.herşeyi biz yaparsak siz nasıl öğreneceksiniz

 

[manda]

İhsan kardeşim mübarek ramazan günü şu makrodan vba dan emin ol debelaniyorum ama emin ol almıyor kafa yaş 40 buyaştan sonra bu kadar oluyor .
Enkısa zamanda öğrenmeye çalışıyorum ama anlatımlar hiç bilmeyenlerin düzeyinde değil o yüzden çok zorlanıyorum...
Oyüzden şu kodları yollarsan şu ramazanda bir sewaba girersin.

 

[İhsan Tank]

İhsan kardeşim mübarek ramazan günü şu makrodan vba dan emin ol debelaniyorum ama emin ol almıyor kafa yaş 40 buyaştan sonra bu kadar oluyor .
Enkısa zamanda öğrenmeye çalışıyorum ama anlatımlar hiç bilmeyenlerin düzeyinde değil o yüzden çok zorlanıyorum...
Oyüzden şu kodları yollarsan şu ramazanda bir sewaba girersin.

ekledim siz de mümkünse türkçe kelimeler kullanın
dikkat etmeniz dileğiyle

 

[thecarow]

Hocam;
ÖNCELİKLE HAYIRLI RAMAZANLAR.BEN ARKADAŞIN ÖRNEĞİNDE BAZI DEĞİŞİKLİKLER YAPTIM.BU ÖRNEKDE B-C-D-E SÜTUNLARININ 2-3-4 NOLU SATIRLARINDAKİ BİLGİLERİ AYNI.BUNLARIN F-G-H-I-J VE K SÜTUNLARINDAKİ RAKAMLARININ TOPLAMLARINI İLGİLİ GÖNDERİLEN SAYFADA (ÖRN.ÇELİK) TEK SATIRDA NASIL YAZDIRABİLİRİZ.
SAYGILARIMLA.

 

[hamitcan]

BUNLARIN F-G-H-I-J VE K SÜTUNLARINDAKİ RAKAMLARININ TOPLAMLARINI İLGİLİ GÖNDERİLEN SAYFADA (ÖRN.ÇELİK) TEK SATIRDA NASIL YAZDIRABİLİRİZ.
SAYGILARIMLA.

Her sayfada, aktarılan her bir satır için formülle bir toplam hücresi oluşturabilirsiniz.

 

[thecarow]

Hocam ilginiz için öncelikle teşekkür ederim.Daha tam hakim olamadığım için bu konuda yol gösterebilirmisiniz.

 

[hamitcan]

Yukarıda belirttiğim gibi, her bir sayfa içinde bir toplam sütunu oluşturun.

 

[thecarow]

Hocam bunu makro kodları ilemi yapacağım

 

[halit3]

kodun bu bölümünden sonra

Sheets(arr(j)).Range("a" & d & ":" & "j" & d) = Sheets("TOPTAN").Range("a" & k & ":" & "j" & k).Value

Bunu ekleyiniz.

Sheets(arr(j)).Cells(d, "x").Value = WorksheetFunction.Sum(Sheets("TOPTAN").Range(Sheets("TOPTAN").Cells(k, 6), Sheets("TOPTAN").Cells(k, 11)))

not:
Marka sutununna yani (X) sutünuna taptan sayfasındaki f,g,h,ı,j,k sutünlarını topluyor

 

[manda]

Çok özür dileyerek araya girebilirmiyim.Bu belgemin içine birde satış sayfası ekledim ve userforma aynı toptan sayfasındaki gibi verielri gireceğim.Bunun için toptan sayasındaki kodlardan yararlanmaya çalıştım.Ama kaydet label'ını bir türlü çalıştıramadım.Lütfen yardımcı olurmusunuz.
Bu arada Sayın Hamit can ve Sayın İhsan tank beylere dünkü yardımlarından dolayı dün iftar
vakti yalaştığı için yazamadım çok teşekkür ederim.

 

[hamitcan]

Private Sub CommandButton1_Click()
    Range("A1").Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
    For i = 1 To 10
    ActiveCell.Offset(0, i - 1).Value = Me.Controls("ComboBox" & i).Value
    Next i
    For i = 1 To 10
    Me.Controls("ComboBox" & i).Value = ""
    Next i
End Sub

Yukarıdaki kodu çalıştırmak istiyorsanız, kod başlığını değiştimelisiniz. Yani aşağıdaki gibi olmalı.

Private Sub Label8_Click()
    Range("A1").Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
    For i = 1 To 10
    ActiveCell.Offset(0, i - 1).Value = Me.Controls("ComboBox" & i).Value
    Next i
    For i = 1 To 10
    Me.Controls("ComboBox" & i).Value = ""
    Next i
End Sub

 

[manda]

öncelikle yardımlarınız için teşekkürler.
Dediğiniz gibi yaptım ama şöyle bir mesaj aldım nedir bu
ActiveCell.Offset(0, i - 1).Value = Me.Controls("ComboBox" & i).Value

 

[manda]

ayrıca şunu da yapamk istiyorum acaba çıkş butonunu çalıştırmak için gerekli kodlar nelerdir acaba
Saygılarımla......