sayfa aç ve aktar

[h.temel]

sayı h.temel sanal bilgiler yazacağınıza elma armut gibi birşeyler yazıp görünmesini istediklerinizi ve istemediklerinizi ayrı ayrı renklendirip açıklayıcı anlatsanız daha iyi olur sanırım.

Sayın redgirl anlaşılır olsun diye sorumu ve dosyayı olabildiğince basit tutmaya çalıştım, istediğiniz gibi asıl dosyayı gönderdim umarım daha açıklayıcı olur.

 

[h.temel]

arkadaşlar derdimi anlatamıyormuyum yoksa zor birşeymi istiyorum bunu söyleyin bari.

 

[baydeniro]

Sayın h.temel, sayın Murat Osma çok teşekkür ederim. Güzel bir çalışma.

 

[h.temel]

Sayın h.temel, sayın Murat Osma çok teşekkür ederim. Güzel bir çalışma.

serdar bey işinize yararsa ne mutlu size ama benim işime yaramıyor.

 

[Murat OSMA]

Ben neden daha fazla yardımcı olamayacağımı imzamda belirttim....

 

[Murat OSMA]

Temel Bey, yine de son kez şu kodları bir denemenizi rica ediyorum;

Sub sayfa_ac_ve_aktar()
    Dim Sayfa_Adi As String
    If [D2] = "" Then Exit Sub
    Sayfa_Adi = [D2]
    
    If Not SayfaVarMi(Sayfa_Adi) Then
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Sayfa_Adi
        Sheets("siparis").Select
    End If
    Application.ScreenUpdating = False
    Dim syf As Worksheet
    Dim sf As String
    sf = Sayfa1.Range("D2").Value
        For Each syf In Worksheets
            If syf.Name <> "siparis" And syf.Name <> "musteri" And syf.Name = sf Then
               Cells.Copy Sheets(sf).Range("A1")
            End If
                For i = Range("A65536").End(3).Row To 9 Step -1
                    If Sheets(sf).Cells(i, 3) = "" Then
                        Sheets(sf).Rows(i).Delete
                    End If
                Next i
        Next syf
        Range("C9:C200").ClearContents
    Sheets(sf).Select: Columns.AutoFit
    sf = vbNullString: Set syf = Nothing
    MsgBox "sipariş aktarıldı"
    Sheets("siparis").Select
 Application.ScreenUpdating = True
End Sub

 

[h.temel]

Murat Bey ilginiz için teşekkür ederim, dosyayı redgirl istediği için değiştirdim, verdiğiniz kod işime yaradı sadece 1 yerde sıkıntı var sayfayı aktardığında aktarılan sayfadakileri silmeden öncekinin altına ekletebilir miyiz?

 

[Murat OSMA]

Temel Bey, şu şekilde bir deneyiniz;

Sub sayfa_ac_ve_aktar()
    Dim Sayfa_Adi As String
    If [D2] = "" Then Exit Sub
    Sayfa_Adi = [D2]
    If Not SayfaVarMi(Sayfa_Adi) Then
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Sayfa_Adi
        Sheets("siparis").Select
    End If
    Application.ScreenUpdating = False
    Dim syf As Worksheet
    Dim sf As String
    sf = Sayfa1.Range("D2").Value
        For Each syf In Worksheets
            If syf.Name <> "siparis" And syf.Name <> "musteri" And syf.Name = sf Then
                Sheets("siparis").UsedRange.Copy
                Sheets(sf).Range("A65536").End(3)(2, 1).PasteSpecial
            End If
                For i = Sheets(sf).Range("A65536").End(3).Row To 1 Step -1
                    If Sheets(sf).Cells(i, 3) = "" Then
                        Sheets(sf).Rows(i).Delete
                    End If
                Next i
        Next syf
    Range("C9:C200").ClearContents
    Sheets(sf).Columns("B:B").ColumnWidth = 34.57
    Sheets(sf).Cells.EntireRow.AutoFit
    Sheets(sf).Columns.AutoFit
    sf = vbNullString: Set syf = Nothing
    MsgBox "sipariş aktarıldı"
    Sheets("siparis").Select
 Application.ScreenUpdating = True
End Sub

 

[h.temel]

Murat Bey vakit ayırdığınız için çok teşekkür ederim, en son verdiğiniz kod sipariş sayfasındaki 3, 4 ve 6 nolu satırları aktarmıyor. Ayrıca aktarılan sayfada aktarılanlar arasına 3 adet boş satır ekleyebilirmiyiz? Ekteki dosyada da belirttim.

 

[Murat OSMA]

Mesajımdaki kodları tekrar tekrar alıntı yapmanıza gerek yok, sadece gereksiz yer kaplıyorlar.
Eğer düzelt butonunuz aktifse silmenizi rica edeceğim..

3 - 4 - 6 ve 8. satırı aktarmıyordur.. C3 - C4 - C6 ve C8 hücrelerine birer . (nokta) koyarsanız onları da aktaracaktır...

Şu kodları bir deneyiniz;

Sub sayfa_ac_ve_aktar()
    Dim Sayfa_Adi As String
    Dim son As Integer
    If [D2] = "" Then Exit Sub
    Sayfa_Adi = [D2]
    If Not SayfaVarMi(Sayfa_Adi) Then
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Sayfa_Adi
        Sheets("siparis").Select
    End If
    Application.ScreenUpdating = False
    Dim syf As Worksheet
    Dim sf As String
    sf = Sayfa1.Range("D2").Value
        For Each syf In Worksheets
            If syf.Name <> "siparis" And syf.Name <> "musteri" And syf.Name = sf Then
                Sheets("siparis").UsedRange.Copy
                Sheets(sf).Range("A65536").End(3)(2, 1).PasteSpecial
            End If
    With Sheets(sf)
        For i = .Range("A65536").End(3).Row To 2 Step -1
            If .Cells(i, 3) = "" Then
                .Rows(i).Delete
            End If
            If .Cells(i, 1) = "Siparişi Alan" Then
                .Rows(i & ":" & 3 + i - 1).Insert Shift:=xlDown
            End If
        Next i
        .Columns("B:B").ColumnWidth = 34.57
        .Cells.EntireRow.AutoFit
        .Columns.AutoFit
        .Rows("1:3").Delete Shift:=xlUp
    End With
        Next syf
    Range("C9:C200").ClearContents
    sf = vbNullString: Set syf = Nothing
    MsgBox "sipariş aktarıldı"
    Sheets("siparis").Select
 Application.ScreenUpdating = True
End Sub

Not: Tasarım sorunlu olduğu için kodlar bu kadar uzuyor...

Ayrıca kodları da tekrar bir elden geçirmek gerek, kimin eli kimi cebinde belli değil...
Sonuzu yazarsınız...

Hoşça kalın !!!

 

[h.temel]

Murat Bey C3 - C4 - C6 ve C8 hücreleri birleştirilmiş hücreler buraya birşey giremiyorum, tasarım sorunlu derken birleşik hücre olmasınmı demek istediniz. Gerekiyor ise yeniden sayfayı düzenlerim.

 

[Murat OSMA]

Temel Bey, o hücrelere sadece . (nokta) koyacaksınız. Nasıl bir şey giremiyorsunuz, anlamadım ?
Tam anlatamadım mı yoksa ? :dusun:

Siz nasıl kullanıyorsanız, nasıl rahatınıza gidiyorsa o şekilde kullanın, o şekilde form hazırlayın.
Sonuçta kodlar bu işin görünmeyen kısmında. Kullandığınız formun sade ve anlaşılır bir şekilde olmasına özen gösterin.
Gereksiz kenarlıkları, birleştirilmiş hücreleri pek kullanmanızı tavsiye etmem.

Şimdilik dediğim gibi, belirttiğim hücrelere . işareti koymanız yeterli...

Daha sonra isterseniz tekrar üzerinde çalışırız..

İyi akşamlar...

 

[h.temel]

Merhaba Murat Bey,

Belirttiğiniz hücreler başka hücreler ile birleştirilmiş olduğundan nokta koyamıyorum. Neyse bende tasarımı değiştirip birleştirmeleri kaldırmaya ve tek hücreye düşürmeye çalıştım ama 1 tanesini halledemedim. Dosyanın son hali ekte dosyada belirttiğim 3 tane sorunum var vaktiniz olur ise ilgilenmenizi rica ederim.

 

[h.temel]

Yardımınızı bekliyorum,

 

[Murat OSMA]

Afedersiniz Temel Bey, sizin konunuzu unuttum.
Eve gidince baksam olur değil mi ?

 

[h.temel]

Estağfurullah Murat Bey, acelem yok ne zaman vaktiniz olursa,

 

[Murat OSMA]

Rica etsem 2003 formatında tekrar yükler misiniz ?
Evdeki bilgisayarımda 2003 yüklü olduğu için üzeri versiyonları açamıyorum...

 

[h.temel]

dosya ektedir

 

[Murat OSMA]

Temel Bey, dosyayı bir dener misiniz ?

Gözümden kaçan bir şey olabilir, söylersiniz düzeltirim..

 

[h.temel]

Murat Bey, zahmet verdim size ama tam istediğim gibi oldu, bu dosya benim işimi çok hızlandıracak çok çok teşekkür ederim.