makro

[1903emre34@gmail.com]

arkadaşlar örneğin hesap kodu olan 100 00 001 diğer sayfa 2 aktarmak istiyorum başka farklı muhasebe kodu 102 00 002 sayfa 3 aynı şekilde hesap kodu 102 00 003 sayfa 4 getirecek şekilde bunun gibi makro kodu mümkün mü?

 

[Ömer BARAN]

Merhaba.

Sanırım istediğinizi aşağıdaki kod karşılar.
Kod'u boş bir MODÜL'e yapıştırın ve çalıştırın.
.

[FONT="Arial Narrow"]Sub SAYFA_OLUŞTUR_AKTAR()
Set ana = Sheets("Sheet1"): ana.Activate
    Application.DisplayAlerts = False: Application.ScreenUpdating = False
        If Worksheets.Count = 1 Then GoTo 20
50          For sayfa = 1 To Worksheets.Count
                On Error GoTo 50
                    If Sheets(sayfa).Name <> "Sheet1" Then Sheets(sayfa).Delete
                        Next
20                          For satır = 1 To ana.[B65536].End(3).Row
                                If ana.Cells(satır, 1) = "HESAP KODU:" Then
                                    Set syf = ThisWorkbook.Sheets.Add(After:= _
                                    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                                syf.Name = Left(ana.Cells(satır, 2), 10)
                            topsat = WorksheetFunction.Match("TOPLAM   :", ana.Range("A" & _
                        satır & ":A65536"), 0) + satır - 1
                    ana.Range(ana.Cells(satır, 1), ana.Cells(topsat, 8)).Copy
                syf.Activate: ActiveSheet.Paste: Cells.EntireColumn.AutoFit
            Application.CutCopyMode = False: syf.[A1].Select: ana.Activate
        End If
10: Next
Application.DisplayAlerts = True: Application.ScreenUpdating = True
MsgBox "TÜM HESAP KODLARI İÇİN YENİ SAYFA OLUŞTURULDU VE VERİLER AKTARILDI"
End Sub[/FONT]

 

[1903emre34@gmail.com]

Ömer hoca teşekkürler

 

[Ömer BARAN]

Estağfurullah, sorun değil.
Kod'u her çalıştırdığınızda açılmış mevcut sayfalar (Sheet1 hariç) silinir ve yeniden oluşturularak veriler aktarılır.
Kod ile ilgili uyarı: Yani açılmış yeni sayfalarda bir işlem yaptıktan sonra kod çalıştırılırsa, yaptığınız işlemleri kaybedersiniz.

 

[1903emre34@gmail.com]

hocam başka durumda örneğin hesap kodu olan 100 00 001 diğer sayfa 2 aktarmak istiyorum muhasebe kodu aynı olan 102 00 002-102 00 003 sayfa 3 hesap kodu 103 00 003 sayfa 4 getirecek şekilde bunun gibi makro kodu mümkün mü?

 

[Ömer BARAN]

Yazdığınızı pek anlayamadım.

Oluşturulması gereken sayfaları kendiniz elle oluşturup,
aktarılması gerekenleri verileri kopyala-yapıştır ile ilgili sayfalara aktararak
yeni bir örnek belge hazırlarsanız bakayım.
.

 

[1903emre34@gmail.com]

bunun gibi çok yeni dosya örnekleme yaptım

 

[Ömer BARAN]

Tekrar merhaba.

Aşağıdaki kod'u boş bir MODÜLe yapıştırın ve çalıştırın.
.

[FONT="Arial Narrow"]Sub SAYFA_OLUŞTUR_AKTAR()
Set ana = Sheets("Sheet1"): ana.Activate
    Application.DisplayAlerts = False: Application.ScreenUpdating = False
        If Worksheets.Count = 1 Then GoTo 20
50          For sayfa = 1 To Worksheets.Count
                On Error GoTo 50
                    If Sheets(sayfa).Name <> "Sheet1" Then Sheets(sayfa).Delete
                        Next
                            ilksat = WorksheetFunction.Match("HESAP KODU:", ana.Range("A:A"), 0)
                                ana.Range("I:I").ClearContents
                                    For sat = ilksat To ana.[B65536].End(3).Row
                                        If ana.Cells(sat, 1) = "HESAP KODU:" Then
                                            ana.Cells(sat, 9) = Left(Cells(sat, 2), 3)
                                                Else
                                                    ana.Cells(sat, 9) = ana.Cells(sat - 1, 9)
                                                        End If
                                                            Next
20                                                      For satır = ilksat To ana.[B65536].End(3).Row
                                                    If ana.Cells(satır, 9) <> ana.Cells(satır - 1, 9) Then
                                                Set syf = ThisWorkbook.Sheets.Add(After:= _
                                            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                                        syf.Name = ana.Cells(satır, 9)
                                topsat = satır + WorksheetFunction.CountIf(ana.Range("I:I"), syf.Name) - 1
                            ana.Range(ana.Cells(satır, 1), ana.Cells(topsat, 8)).Copy
                        syf.Activate: ActiveSheet.Paste: Cells.EntireColumn.AutoFit
                    Application.CutCopyMode = False: syf.[A1].Select: ana.Activate
                End If
10:         Next: ana.Range("I:I").ClearContents
        Application.DisplayAlerts = True: Application.ScreenUpdating = True
    MsgBox "ANA HESAP KODLARI İÇİN AYRI SAYFALAR OLUŞTURULDU" & vbLf & _
"VERİLER İLGİLİ SAYFALARA AKTARILDI", vbInformation, "1903emre34"
End Sub[/FONT]

 

[1903emre34@gmail.com]

hocam ilgilendiğiniz çok teşekkürler tam istediğim gibi oldu kusura bakmayın sizin zamanı aldık

 

[Ömer BARAN]

İyi günler dilerim.

UYARI:
-- MUAVİN sayfasında I sütunu kod tarafından kullanılıyor. Bu nedenle I sütununda işlem yapmayınız,
-- Önceki cevabımda da belirttiğim gibi; oluşmuş sayfalarda işlem yaptıktan sonra kod çalıştırılırsa yaptığınız işlemleri kaybedersiniz.
.

 

[isfa67]

2013 excellde basit bir userform yaptım ama butona tıkladığımda hata veriyor userformu getiremiyorum.burdaki örnekler genelde 2010 ve gerisi butona (resim kullandım buton yerine)makro atadım ama hata veriyor.ne yapmam lazım

 

[Ömer BARAN]

2013 excellde basit bir userform yaptım ama butona tıkladığımda hata veriyor userformu getiremiyorum.burdaki örnekler genelde 2010 ve gerisi butona (resim kullandım buton yerine)makro atadım ama hata veriyor.ne yapmam lazım

Merhaba

Sorunuzun, açılmış olan konuyla bir ilgisi yok sanırım.

Sorunuzu; cevabımın altındaki İMZA bölümünde yer alan açıklamaları okuyarak hazırlayacağınız
(elbette kullandığınız kod'unda içinde olduğu) bir örnek belge ile destekleyip
yeni konu açarak sorarsanız daha hızlı ve net sonuca ulaşacağınızı düşünüyorum.
.