- Katılım
- 21 Eylül 2005
- Mesajlar
- 32
A | B | C | D | E | F | G | H |
Stok Grubu | Stok Kodu | Stok Adı | Birim | Giren | Çıkan | Kalan | Durumu |
Aşağıdaki kodlar (alıntıdır) Yukarıdaki tablodaki verileri "Stok Grubu"'na (A sütunu) göre ayırıp yeni sayfalara kopyalama yapmaktadır.
Banim yapmak istediğim; Bu Ürün Grubu'na göre sayfalara kopyalama işlemini; Asıl dosyanın bulunduğu yerde YENİ BİR DOSYAYA oluşturarak (günün tarihi+asıl dosya adı örneğin:ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & asıldosyaadı & "-" & Date & ".xlsx") kaydetmek.
(sayfa isimleri ürün adı olacak şekilde)
Yardımlarınız için şimdiden teşekkür ederim.
Örnek Ürün Grubu
Baharat |
Baharat |
Bakliyat |
Bakliyat |
Bakliyat |
Sebze |
Aynı dosyaya ayırarak kopyalayan kodlar:
Sub GruplariAyir()
Application.ScreenUpdating = False
Dim s1 As Worksheet
Set s1 = Sheets("Stoklar")
Dim Sayfa As String
For a = 2 To s1.Cells(Rows.Count, "a").End(3).Row
Sayfa = s1.Cells(a, "a")
If Not SayfaVarMi(Sayfa) Then
Sheets.Add
ActiveSheet.Name = Stoklar
Sheets(Sayfa).Move after:=Sheets(Sheets.Count)
s1.Range("A1:H1").Copy Range("A1")
End If
sonsatır = Sheets(Sayfa).Cells(Rows.Count, "A").End(3).Row + 1
s1.Range(s1.Cells(a, "A"), s1.Cells(a, "H")).Copy _
Sheets(Sayfa).Cells(sonsatır, "A")
Next a
Application.ScreenUpdating = True
MsgBox "Grup Ayırma İşlemi Tamalandı"
End Sub