Verileri Sayfa oluştur iki tarihli aktar

Katılım
30 Kasım 2006
Mesajlar
411
Excel Vers. ve Dili
Excel 2007 - Türkçe
Altın Üyelik Bitiş Tarihi
05.07.2020
Kurumumuzun firmalardan aldığı hizmetlerin aylık ve yıllık izlemleri için hazırladığım dökümanlarla ilgili Makro ile biraz çalışma yaptım ama sonuca tam olarak ulaşamadım.

1. Firma isimleri dahilinde açılan sayfalara iki tarih arası verilerin aktarılması
2. İcmal bilançosu


Dosya ilişikte sunulmuş olup, yardımlarınız için şimdiden şükranlarımı sunuyorum.

Saygılarımla....
 

Ekli dosyalar

Katılım
30 Kasım 2006
Mesajlar
411
Excel Vers. ve Dili
Excel 2007 - Türkçe
Altın Üyelik Bitiş Tarihi
05.07.2020
Seçilen iki tarihe göre bilgiler ilgili sayfalara nasıl aktarılacağı ile ilgili kod hazırladım ancak sonuca varamadım. Firma isimlri ile oluşan sayfalara ilgili tarihlerdeki verileri aktarmak istiyorum.
Nasıl bir düzenleme yapmalıyım.

İlginiz için şükranlarımı sunuyorum..

For i = 7 To WorksheetFunction.CountA(Worksheets("VERİ").Range("a7:a65000")) + 1
yer = Worksheets("VERİ").Cells(i, 6).Value
deger = 0
For r = 2 To ActiveWorkbook.Sheets.Count
If Sheets(r).Name = yer Then
deger = 1
End If
Next r

If deger <> 1 Then
Sheets.Add
On Error Resume Next
Sheets(ActiveSheet.Name).Name = yer
Sheets(yer).Move After:=Sheets(ActiveWorkbook.Sheets.Count)

ilk_tarih = CDate(Range("F2").Value)
son_tarih = CDate(Range("F3").Value)

For n = 7 To WorksheetFunction.CountA(Worksheets("VERİ").Range("a7:a65000")) + 1
tarih = CDate(Cells(n, "G").Value)
If Worksheets("VERİ").Cells(n, 6).Value <> "" Then

If tarih >= ilk_tarih And tarih <= son_tarih And Worksheets("VERİ").Cells(n, 6).Value =
Worksheets("VERİ").Cells(i, 6).Value Then

sat = WorksheetFunction.CountA(Worksheets(yer).Range("a2:a65000")) + 10


'For j = 1 To 7
Worksheets(yer).Cells(sat, "A").Value = Worksheets("VERİ").Cells(n, "A").Value ' sATIRLAR
Worksheets(yer).Cells(sat, "B").Value = Worksheets("VERİ").Cells(n, "B").Value
Worksheets(yer).Cells(sat, "C").Value = Worksheets("VERİ").Cells(n, "C").Value
Worksheets(yer).Cells(sat, "D").Value = Worksheets("VERİ").Cells(n, "I").Value
Worksheets(yer).Cells(sat, "E").Value = Worksheets("VERİ").Cells(n, "J").Value
Worksheets(yer).Cells(sat, "F").Value = Worksheets("VERİ").Cells(n, "K").Value
Worksheets(yer).Cells(sat, "G").Value = Worksheets("VERİ").Cells(n, "L").Value
Worksheets(yer).Cells(sat, "H").Value = Worksheets("VERİ").Cells(n, "M").Value
Worksheets(yer).Cells(sat + 1, "G").Value = "TOPLAM"
Worksheets(yer).Cells(sat + 1, "H").Value = ""
'Next j
'Worksheets(yer).Cells(sat, 1).Value = sat - 1
'sat = sat + 1




'If m = 1 Then
'Worksheets(yer).Cells(1, m).Rows("1:1").RowHeight = 25.5
'End If
'Next m


End If
End If
Next n

'For m = 1 To 7
Worksheets(yer).Cells(1, "A").Value = " Firma Adı"
Worksheets(yer).Cells(1, "C").Value = ":" & ActiveSheet.Name

Worksheets(yer).Cells(2, "A").Value = " Mevkutenin Nev'i"
Worksheets(yer).Cells(2, "C").Value = ": Günlük"
Worksheets(yer).Cells(3, "A").Value = " Sayfa Sayısı"
Worksheets(yer).Cells(3, "C").Value = ": "
Worksheets(yer).Cells(4, "A").Value = " Yüzölçümü"
Worksheets(yer).Cells(4, "C").Value = ": "
Worksheets(yer).Cells(5, "A").Value = " Tonu"
Worksheets(yer).Cells(5, "C").Value = ": "
Worksheets(yer).Cells(6, "A").Value = " Günlük Fiili Satış Ortalaması"
Worksheets(yer).Cells(6, "C").Value = ": "
Worksheets(yer).Cells(7, "A").Value = " Dönemi"
Worksheets(yer).Cells(7, "C").Value = ": "

Worksheets(yer).Cells(9, "A").Value = Worksheets("VERİ").Cells(6, "A").Value ' sÜTUN bAŞLIKLARI
Worksheets(yer).Cells(9, "B").Value = Worksheets("VERİ").Cells(6, "B").Value
Worksheets(yer).Cells(9, "C").Value = Worksheets("VERİ").Cells(6, "C").Value
Worksheets(yer).Cells(9, "D").Value = Worksheets("VERİ").Cells(6, "I").Value
Worksheets(yer).Cells(9, "E").Value = Worksheets("VERİ").Cells(6, "J").Value
Worksheets(yer).Cells(9, "F").Value = Worksheets("VERİ").Cells(6, "K").Value
Worksheets(yer).Cells(9, "G").Value = Worksheets("VERİ").Cells(6, "L").Value
Worksheets(yer).Cells(9, "H").Value = Worksheets("VERİ").Cells(6, "M").Value


Worksheets(yer).Cells(9, "A").Interior.ColorIndex = 4
Worksheets(yer).Cells(9, "A").Font.Bold = True
Worksheets(yer).Cells(9, "b").Interior.ColorIndex = 4
Worksheets(yer).Cells(9, "b").Font.Bold = True
Worksheets(yer).Cells(9, "c").Interior.ColorIndex = 4
Worksheets(yer).Cells(9, "c").Font.Bold = True
Worksheets(yer).Cells(9, "d").Interior.ColorIndex = 4
Worksheets(yer).Cells(9, "d").Font.Bold = True
Worksheets(yer).Cells(9, "e").Interior.ColorIndex = 4
Worksheets(yer).Cells(9, "e").Font.Bold = True
Worksheets(yer).Cells(9, "f").Interior.ColorIndex = 4
Worksheets(yer).Cells(9, "f").Font.Bold = True
Worksheets(yer).Cells(9, "g").Interior.ColorIndex = 4
Worksheets(yer).Cells(9, "g").Font.Bold = True
Worksheets(yer).Cells(9, "h").Interior.ColorIndex = 4
Worksheets(yer).Cells(9, "h").Font.Bold = True

Worksheets(yer).Columns("A").ColumnWidth = 4
Worksheets(yer).Columns("B").ColumnWidth = 31
Worksheets(yer).Columns("C").ColumnWidth = 12
Worksheets(yer).Columns("D").ColumnWidth = 12
Worksheets(yer).Columns("E").ColumnWidth = 9
Worksheets(yer).Columns("F").ColumnWidth = 9
Worksheets(yer).Columns("G").ColumnWidth = 10
Worksheets(yer).Columns("H").ColumnWidth = 10
End If

Next i
 
Katılım
30 Kasım 2006
Mesajlar
411
Excel Vers. ve Dili
Excel 2007 - Türkçe
Altın Üyelik Bitiş Tarihi
05.07.2020
Kurumumuzun firmalardan aldığı hizmetlerin aylık ve yıllık izlemleri için hazırladığım dökümanlarla ilgili Makro ile biraz çalışma yaptım ama sonuca tam olarak ulaşamadım.

1. Firma isimleri dahilinde açılan sayfalara iki tarih arası verilerin aktarılması



Dosya sunulmuş olup, öneri ve yardımlarınız için şimdiden şükranlarımı sunuyorum.

Saygılarımla....
 
Üst