Seçime göre bilgi alma

[sward175]

Herkese Merhabalar,
Üç sayfadan oluşan dosyada iki sayfaya veri başlıklarına uygun veri almak istiyorum.
1. Sayfada C1 ve I1 seçimine göre veri almak istiyorum.
2. Sayfada da A1: L1 başlıklarına göre veri almak istiyorum.
Yardımlarınızı rica ederim.
Saygılarımla,
sward175

 

[sward175]

Konu hakkında yardımlarınızı rica ederim.

Saygılarımla,
sward175

 

[sward175]

Herkese Merhabalar,
isteğimi farklı olarak güncelledim.
Üç sayfadan oluşan dosyada iki sayfaya veri başlıklarına uygun veri almak istiyorum.
1. Sayfada B1 ve G1 seçimine göre veri almak istiyorum.
2. Sayfada da A1: L1 başlıklarına göre veri almak istiyorum.
Yardımlarınızı rica ederim.
Saygılarımla,
sward175

 

[Emir Hüseyin Çoban]

.

Dosyanız ektedir.

.

 

[sward175]

Emir Bey,
Gayet güzel çalışyor.
Çok teşekkür ederim.
Sağlıcakla kalın,
sward175

 

[sward175]

Herkese Merhabalar,
Sayın, Emir Hüseyin ÇOBAN arkadaşımızın yardımı ile hazırlamış olduğum dosyada "Maliyet " sayfasının başlıklarını 2. satırdan başlatabilmemiz için kodda değişikliğe ihtiyacım var.
Konu hakkında yardımlarınızı rica ederim.
Saygılarımla,
sward175

 

[sward175]

Herkese Günaydın,
Aşağıdaki kod ile 2 sayfaya veri alıyorum.
Yapmak istediğim "Maliyet" sayfasındaki başlıkları bir satır aşağıdan başlatmak.
İlk satıra Alttoplam ile işlem yapmak istiyorum.
Bunun için aşağıdaki kodun revize edilmesi hususunda yardımlarınızı rica ederim.

Saygılarımla,
sward175

Sub kode1()

Dim SB As Worksheet: Set SB = Sheets("Bilgi Girişi")
Dim SM As Worksheet: Set SM = Sheets("Maliyet")
Dim SMGBA As Worksheet: Set SMGBA = Sheets("Müşteriye göre bilgi alma")

Dim SD As Worksheet: Set SD = Sheets("Bilgi Girişi")
Dim SO As Worksheet: Set SO = Sheets("YARDIMCI")

If SMGBA.Range("B1") = "" Then
MsgBox "Firma İsmi Boş Olamaz", vbCritical
SMGBA.Range("B1").Select
Exit Sub
End If

If SMGBA.Range("G1") = "" Then
MsgBox "Dönem Seçmelisiniz", vbCritical
SMGBA.Range("G1").Select
Exit Sub
End If

SMGBA.Range("A3:L" & Rows.Count).ClearContents
sat = 3

'''''''
Dim liste(), dizi()
son = SD.Cells(Rows.Count, "A").End(3).Row
liste = SD.Range("A3:B" & son).Value
Set dic = CreateObject("scripting.dictionary")

For x = 1 To UBound(liste, 1)
aranan = liste(x, 1)
If Not dic.exists(aranan) Then
dic.Add aranan, ""
End If
Next x

SO.Range("A:A").ClearContents
SO.Range("A1").Resize(dic.Count, 1) = Application.Transpose(dic.keys)

SMGBA.Range("B1").Validation.Delete
SMGBA.Range("B1").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=" & SO.Name & "!$A$1:$A$" & SO.Cells(Rows.Count, "A").End(3).Row
'''''''

aranan = SMGBA.Range("B1") & "#" & UCase(Replace(Replace(SMGBA.Range("G1"), "ı", "I"), "i", "İ"))
For a = 3 To SB.Cells(Rows.Count, "A").End(3).Row
If aranan = SB.Cells(a, "A") & "#" & UCase(Replace(Replace(Format(SB.Cells(a, "B"), "mmmm"), "ı", "I"), "i", "İ")) Then
SMGBA.Cells(sat, "A") = SB.Cells(a, "C")
SMGBA.Cells(sat, "B") = SB.Cells(a, "D")
SMGBA.Cells(sat, "C") = SB.Cells(a, "F")
SMGBA.Cells(sat, "D") = SB.Cells(a, "G")
SMGBA.Cells(sat, "E") = SB.Cells(a, "H")
SMGBA.Cells(sat, "F") = SB.Cells(a, "P")
SMGBA.Cells(sat, "G") = SB.Cells(a, "Q")
SMGBA.Cells(sat, "H") = SB.Cells(a, "R")
SMGBA.Cells(sat, "I") = SB.Cells(a, "S")
SMGBA.Cells(sat, "J") = SB.Cells(a, "T")
SMGBA.Cells(sat, "K") = SB.Cells(a, "U")
SMGBA.Cells(sat, "L") = SB.Cells(a, "V")
sat = sat + 1
End If

Next a
MsgBox " B i t t i (1)"
End Sub

 

[Emir Hüseyin Çoban]

.

Kode2 kodlarında değişiklik yapmalısınız.
Aşağıdaki satırlardaki 2 yazan yerleri değişitirin.

SMGBA.Range("A2:L" & Rows.Count).ClearContents
sat = 2


.

 

[sward175]

Teşekkür ederim.
Saygılar,