• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Iller bazında ürün takip

  • Konbuyu başlatan Konbuyu başlatan ocak26
  • Başlangıç tarihi Başlangıç tarihi
Katılım
20 Mart 2013
Mesajlar
65
Excel Vers. ve Dili
2010 tr
Merhaba Arkadaşlar
Ekli Listede İller bazı ürün talep listesi mevcut.
Yardımlarınızı bekliyorum
Şimdiden Çok teşkkür ederim
 

Ekli dosyalar

Kullanılacak yer isimlerine ait bir listeniz var mıdır acaba?
Çünkü listenizde il dışında ilçe/bölge isimleri de var.
 
bir liste yok...
ilçe/bölge olarak rast gele yazdım....
formüle etki ediyorsa farklı illerle veya ordaki illerle değiştirebiliriz....
 
Merhaba.
Kod:
[FONT="Arial Narrow"][B][COLOR="Blue"]Sub liste_brn()[/COLOR][/B]
Dim s1, s2 As Worksheet, ss1, ss2 As Long, sat As Integer
Set s1 = Sayfa1: Set s2 = Sayfa2
ss1 = s1.Range("C" & Rows.Count).End(3).Row
ss2 = s2.Range("B" & Rows.Count).End(3).Row
If s2.[B65536].End(3).Row > 2 Then s2.Range("B3:F" & ss2).ClearContents
10: For sut = 9 To 15
        sat = s2.[B65536].End(3).Row + 1
        s1.Range(s1.Cells(3, sut), s1.Cells(ss1, sut)).Copy Destination:=s2.Cells(sat, 2)
        s1.Range(s1.Cells(3, 2), s1.Cells(ss1, 5)).Copy Destination:=s2.Cells(sat, 3)
    Next
s2.Range("B3:F" & s2.[B65536].End(3).Row).Sort s2.Range("B2"), 1
s2.Columns("B:F").ColumnWidth = 81.71:s2.Columns("B:F").AutoFit
s2.Rows("3:" & s2.[B65536].End(3).Row).AutoFit
    With s2.Range("B3:F" & s2.[B65536].End(3).Row).Borders
        .LineStyle = xlContinuous: .TintAndShade = 0: .Weight = xlHairline
    End With
MsgBox "İŞLEM TAMAM": s2.Activate
[B][COLOR="Red"]End Sub[/COLOR][/B][/FONT]
 
Son düzenleme:
Geri
Üst