Çalışma Sayfasının bir Kısmını Diğer Sayfaya Getirme

[ERRİC]

Merhabalar aşağıdaki dosyam için yardımınızı rica ediyorum.
Soru: Elimdeki çalışma kitabı bir şablon 50 firma için kullanıyorum "Mizan Aktar" adlı sayfamda mali veri olarak mizan mevcut, bu mizan dediğimiz verinin "b" sutununda hesap kodları var ve bu kodlar her firmada farklılık gösterebiliyor , bu nedenle sabit veri yazıp getirmek uzun ve yorucu oluyor her firmada değiştirmek gerekiyor; bunun yerine ((((("Gelir Tablosu" sayfasına 191.01.001-191.01.002...... liste yapıp e topla ile getirmek yerine)) bu benim nacizane yapmaya çalıştığım))));

"mizan aktar" sayfası "b" sutunundaki kodlara göre "Gelir tablosu" "n" sutununa 190 ile başlayıp 192 ye kadar devam eden hesapların "mizan aktar" "f" sutunundaki bakiyelerini "o" sutununa ve yine "mizan aktar" sayfası "g" sutunudaki "p" sutununa 390 ile başlayıp 392 ye kadar devam eden hesapların "Q"sutununa bakiyelerini otomatik getirse olur mu ; yani ben her firmada sürekli kod girmek istemiyorum ve görüntü excel gelir tablosu sayfasında çirkin oluyor ve yazdırma alanı büyüyor
Örneğin hareket görmesi muhtemel hesap planı bazen şu şekilde olabiliyor; Biraz karışık oldu ama örneğini; gelir tablosu sayfası n sutununda yapmaya çalıştım
Saygılar

191	İNDİRİLECEK KATMA DEĞER VERGİSİ
191.01	TEVKİFATSIZ MAL-HİZMET ALIŞ KDV
191.01.001	% 1 İNDİRİLECEK K.D.V.
191.01.002	% 8 İndirilecek K.D.V
191.01.003	%18 İndirilecek K.D.V
191.02	TAM TEVKİFATLI MAL-HİZMET ALIŞ KDV
191.02.001	% 1 İNDİRİLECEK K.D.V.
191.02.002	% 8 İNDİRİLECEK K.D.V.
191.02.003	% 18 İNDİRİLECEK K.D.V.
191.03	KISMİ TEVKİFATLI MAL-HİZMET ALIŞ KDV
191.03.001	% 1 İNDİRİLECEK K.D.V.
191.03.002	% 8 İNDİRİLECEK K.D.V.
191.03.003	% 18 İNDİRİLECEK K.D.V.
191.04	SATIŞLARDAN İADE KDV
191.04.001	% 1 İNDİRİLECEK K.D.V.
191.04.002	% 8 İndirilecek K.D.V
191.04.003	% 18 İNDİRİLECEK K.D.V.
191.05	DEMİRBAŞ ALIŞ KDV
191.05.001	% 1 İNDİRİLECEK K.D.V.
191.05.002	% 8 İNDİRİLECEK K.D.V.
191.05.003	% 18 İNDİRİLECEK K.D.V.
191.06	İTHAL MAL-HİZMET ALIŞ KDV
191.06.001	% 1 İNDİRİLECEK K.D.V.
191.06.002	% 8 İNDİRİLECEK K.D.V.
191.06.003	% 18 İNDİRİLECEK K.D.V.
191.40	DEVREDEN KDV
191.40.01	. İLÇESİ . ADA PARSEL TOPLAM ..M2 ALAN
191.40.01.001	% 1 İNDİRİLECEK K.D.V.
191.40.01.002	% 8 İNDİRİLECEK K.D.V.
191.40.01.003	% 18 İNDİRİLECEK K.D.V.
191.40.02	. İLÇESİ . ADA PARSEL TOPLAM ..M2 ALAN
191.40.02.001	% 1 İNDİRİLECEK K.D.V.
191.40.02.002	% 8 İNDİRİLECEK K.D.V.
191.40.02.003	% 18 İNDİRİLECEK K.D.V.

 

[YUSUF44]

Hangi satırların alınacağını belirten kesin kural nedir?

Örneğin dosyanızda
191
191.01
191.01.001
191.01.008
191.01.018

satırları mevcut. Bunların alttaki 3 tanesini arıyoruz anladığım kadarıyla. Neden ilk ikisini almıyoruz da alttakileri almamız gerekiyor? Excel alttakilerin alınması gerektiğini nasıl anlayacak? Bu firma için bu şekildeyken başka firmada farklı bir formatta olabilir mi?

 

[ERRİC]

Merhaba;
1-190-192 arası ve 391-393 arası satırları almam gerekiyor,
2-evet alttaki hesaplar ara hesaplar, yukarıdakilerde bunların toplamları; ayrı ayrı gelmesinde bir mahsur yok yani sadece alt hesapların fakat veriyi okurken; diğer kullanıcılar anlamakta zorlanıyorlar hangi gruba ait olduklarını anlamakta veya rapor verdiğimiz kişiler anlamıyor;
3-evet bazı firmaların hesap kod yapısı farklı; bu fark hesapların bazen firmalarda tutulması bazen de bizim ofisimizde stanrad şablon ile tutulmasından kaynaklı yani örnek olarak şu şekilde;
(191 de benzer yapıda oluyor)
a Firması hesap yapısı;
391
391.01 Normal Kdv
391.01.001 %1 Kdv
391.01.002 %8 Kdv
391.01.003 %18 Kdv
391.02 Tevkifatlı
391.02.001 %1 Kdv
391.02.002 %8 Kdv
391.02.003 %18 Kdv
b firması
391
391.01 Normal Kdv
391.01.001 %1 Kdv
391.01.008 %8 Kdv
391.01.018 %18 Kdv
391.02 Tevkifatlı Kdv
391.02.001 %1 Kdv
391.02.008 %8 Kdv
391.02.018 %18 Kdv
ve bu 391-191 grup ve alt hesap kod listesi soru içerisinde mevcut ama her zaman hepsi hareket görmüyor; bizim kullandığımız şablon 40 firma için aynı diğer 10 firmada farklı ; ama yine de ;
her firmada kodlar 191 ve 391 ile başlar ; bu yüzden özetle;
x sayfasında ki alt alta sıralı 191 ve 391 hesapları gördüğünde , 191 ve 391 satır dahil aralıktaki tüm hesap kodlarını ve soruda belirttiğim ilgili sutundaki rakamları dökmesi yeterli yanlarına topla çıkar işlemi yapıcağız; bu çalışma da baya sorum olacak ilerlyene zamanlarda grupta buna benzer bir çalışma vardı sanırım eskiden ama kaldırılmış bunun gibi mali veriler de bir takım analiz yapacağız; ama excel bilgimiz kısıtlı sizlerin desteği ile geliştireceğiz inşallah

 

[YUSUF44]

Ben sorumu tam anlatamadım sanırım. Tabloya muhasebeci gözüyle değil konuyu hiç bilmeyen biriymiş gibi bakın ve hangi satırları almamız gerektiğini nasıl anlayacağımızı anlatın. Örneğin 191'le başlayan hangi satırları alacağımıza ilişkin bir kural var mı? Mesela 191.xx.xxx şeklindeki standart kalıbı görünce mi alacağız yoksa bu kalıp her zaman geçerli değil mi? Geçerli değilse hangi satırın alınacağını nasıl anlayacağız?

 

[ERRİC]

Yusuf bey ;
1-kural yok ;
2-mizan sayfasındaki 191 ve 391 ile başlayan satırları alıcaz; yani
191
191.01
191.01.001
...... vs bu şekilde 191 ve 391 ile başlayan satırları gördüğünde; diğer sayfaya özet getirecek; diğer sayfada düşeyara vs yapmadan mı artık nasıl ise ilk soruda bahsettiğim diğer sayfaya dökecek; her zaman genelde 191 ve 391 ile başlayan satırlar var; 191. ler az öncede bahsettiğim gibi 191.01.001-191-01-001 gibi olabiliyor;
mizan sayfasında genelde 191 ve 391 ile başayacak SATIRLAR muhakkak olacak;
gelir tablosu sayfasına en kötü bir sutuna bu hesapları standart kalıp şeklinde yazıp ; düşeyara ile getirtilebilir sanırım ; ama bu hem kalabalık yaratacak; açıkçası satırda bellir bir kısmı "191" veya "391" içeren satırları buldurup veriler getirtilebilir ama yapamıyorum, veya başka bir yolu olabilir; bu bir özet tablo veya resim ile tekrar yolluyorum;

 

[asi_kral]

Merhaba
Kodu dener misiniz
Orjinal sayfanızla oynamak istemedim makronun geri dönüşü olmayacağı için.
Yeni bir sayfa açıyor ve bilgileri getiriyor. Böyle bir şey istiyorsanız orjinal sayfanıza ekleyebiliriz.

Sub getir()
Dim S1 As Worksheet, S2 As Worksheet, STR1 As Long, STR2
Set S1 = Sheets("Mizan Aktar")
Sheets.Add after:=Sheets(Sheets.Count)
Set S2 = Sheets(Sheets.Count)
STR2 = S2.Range("A" & Rows.Count).End(xlUp).Row
STR1 = S1.Range("B" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "190*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:B" & STR1).Copy S2.Range("A" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("B" & STR2)
End If
STR2 = S2.Range("A" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "191*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:B" & STR1).Copy S2.Range("A" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("B" & STR2)
End If
STR2 = S2.Range("A" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "192*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:B" & STR1).Copy S2.Range("A" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("B" & STR2)
End If
'--------------------------------------------
STR2 = S2.Range("D" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "390*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:B" & STR1).Copy S2.Range("D" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("E" & STR2)
End If
STR2 = S2.Range("D" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "391*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:B" & STR1).Copy S2.Range("D" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("E" & STR2)
End If
STR2 = S2.Range("D" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "392*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:B" & STR1).Copy S2.Range("D" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("E" & STR2)
End If
S1.Range("B3:J" & STR1).AutoFilter
S2.Columns("A:A").EntireColumn.AutoFit: S2.Columns("B:B").EntireColumn.AutoFit
S2.Columns("D:D").EntireColumn.AutoFit: S2.Columns("E:E").EntireColumn.AutoFit
End Sub

 

[ERRİC]

Elinize sağlık yeni sayfaya da gelmesi yeterli gerekirse kopyala yapıştır yaparım; hesap adının da gelmesini sağlar mısınız lütfen; ben kullanıma göre yeri ihtiyaçlar oldukça desteğinizi almak isterim; ayrıca bu yaptığınız 191-391 hesapları gibi bir kaç hesap da getirtmeliyim; fakat aynı sayfaya olur mu bilemiyorum sırası gelince foruma yazacağım teşekkürler

 

[asi_kral]

Merhaba
Kodu bununla değiştirebilirsiniz?

Sub getir()
Dim S1 As Worksheet, S2 As Worksheet, STR1 As Long, STR2
Set S1 = Sheets("Mizan Aktar")
Sheets.Add after:=Sheets(Sheets.Count)
Set S2 = Sheets(Sheets.Count)
STR2 = S2.Range("A" & Rows.Count).End(xlUp).Row
STR1 = S1.Range("B" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "190*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:C" & STR1).Copy S2.Range("A" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("C" & STR2)
End If
STR2 = S2.Range("A" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "191*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:C" & STR1).Copy S2.Range("A" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("C" & STR2)
End If
STR2 = S2.Range("A" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "192*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:C" & STR1).Copy S2.Range("A" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("C" & STR2)
End If
'--------------------------------------------
STR2 = S2.Range("D" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "390*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:C" & STR1).Copy S2.Range("D" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("F" & STR2)
End If
STR2 = S2.Range("D" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "391*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:C" & STR1).Copy S2.Range("D" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("F" & STR2)
End If
STR2 = S2.Range("D" & Rows.Count).End(xlUp).Row
S1.Range("B3:J" & STR1).AutoFilter 1, "392*"
If WorksheetFunction.Subtotal(3, S1.Range("B4:B" & STR1)) > 0 Then
S1.Range("B4:C" & STR1).Copy S2.Range("D" & STR2)
S1.Range("F4:F" & STR1).Copy S2.Range("F" & STR2)
End If
S1.Range("B3:J" & STR1).AutoFilter
S2.Columns("A:A").EntireColumn.AutoFit: S2.Columns("B:B").EntireColumn.AutoFit: S2.Columns("C:C").EntireColumn.AutoFit
S2.Columns("D:D").EntireColumn.AutoFit: S2.Columns("E:E").EntireColumn.AutoFit: S2.Columns("F:F").EntireColumn.AutoFit
End Sub

Dilediğiniz yere bu bilgileri getirebiliriz.
Dediğim gibi makronun geri dönüşü olmadığı için verilerde bozulma olmaması için böyle bir şey yaptım sonuçları gözlemleyin diye.
Başka kodları da böyle getirebilirsiniz. Yalnız bu o kadar sağlıklı olur mu onu bilemedim.
Ben sizin yerinizde olsam koda bir şekilde sizin istediğiniz kodların dokümanını yaptırarak sonuca ulaşırdım. Örneğin 191'in sonuçları gelsin vs.
Kolay Gelsin.

 

[YUSUF44]

Anladığım kadarıyla alternatif olarak aşağıdaki makroyu dener misiniz?

Sub KDV()
Set s1 = Sheets("Mizan Aktar")
Set s2 = Sheets("Gelir Tablosu")
eski = WorksheetFunction.Max(4, s2.Cells(Rows.Count, "N").End(3).Row, s2.Cells(Rows.Count, "Q").End(3).Row)
s2.Range("N4:S" & eski).ClearContents

son = WorksheetFunction.Max(4, s1.Cells(Rows.Count, "B").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no;imex=1"""

sorgu = "select F1,F2,F5 from [Mizan Aktar$B4:J" & son & "] where F1 like '190.%' or " _
        & "F1 like '191.%' or F1 like '192.%'"
Set rs = con.Execute(sorgu)

s2.[N4].CopyFromRecordset rs

sorgu = "select F1,F2,F6 from [Mizan Aktar$B4:J" & son & "] where F1 like '390.%' or " _
        & "F1 like '391.%' or F1 like '392.%'"
Set rs = con.Execute(sorgu)

s2.[Q4].CopyFromRecordset rs
s2.Columns("N:S").EntireColumn.AutoFit
End Sub

 

[ERRİC]

Hocam cevaplarınız için çok teşekkür ederim işim gereği ancak bugün bakabildim; saygılar