Bilgi dökümü

[manisali50]

Arkadaşlar merhaba.
Korhan Ayhan üstadımın büyük ilgi ve gayreti ile yaptığım programa ufak bir ilave yapma zorunluluğu doğdu. Yine yardımlarınızı bekliyorum.
Ekteki dosyada Sayfa1'de bulunan CM/CT sütünunda tezfahların CM ya da CT gruplarından hangisine dahil olduğu yazıyor..Benim isteğim şu :
Tezgah CM grubundan ise "CM TEZGAHLARI" sayfasına,CT grubundan ise "CT TEZGAHLARI" sayfasına aktarılması..
Şimdiden teşekkürler.

 

[Civan Jack]

Ya bende bir sorun var ya da artık siteye sıkıştırmadan yüklenen excel dosyalarında bir problem oluyor. Hasarlı mesajı veriyor.

Sizde de oluyor mu ?

 

[manisali50]

Hata sizde arkadaşım..Bende öyle bir problem yok..

 

[Civan Jack]

Enteresan, indirdiğimde aşağıdaki gibi uyarı geliyor.

Masaüstünde çift tıklayıp açtığımda dosya hasarlı uyarısı geliyor.
Ama sağ tıklayıp özelliklerden excel ile birlikte aç dediğimde açılıyor.
Dediğiniz gibi sorun az da olsa bendeymiş, ama daha önce böyle bir hata uyarısı vermiyordu, neden şimdi böyle oldu onu hala anlamadım.
İyi geceler.

 

[manisali50]

Arkadaşım..Sorun "az da olsa" değil,TAMAMIYLA sizin pcde..Çünkü benim pcde document and settings dizininin altında "sweet" ve "opera" diye alt dizinler yok..Onlar sizin pcde var sanırım..Neyse önemli değil..Az önce kontro ettim ,sağlıklı çalışıyor..İlginize tekrar teşekkür ederim.

 

[Civan Jack]

Ben Opera browser (tarayıcı) kullanıyorum, Sweet de benim bilgisayarımın adı Sn. manisali50.
İnternette gezdiğim her sitenin ve indirdiğim her bağlantının kaydını alıyor Opera.
Sizin .rar dosyasınıda indirdiğim için orada görüntülüyor.

Sitedeki birkaç .xls uzantılı dosyayı indirdim, bazılarında sizin dosyada olduğu gbi dosya hasarlı uyarısı geld ama sağ tıkla excel ile birlikte aç dediğimde açtı, bazılarında da sorunsuz bir şekilde açtı.

Neyse Sn. manisalı şu an için sorun yok gibi görünüyor.
Teşekkürler.

 

[Civan Jack]

Aşağıdaki kodlar işinize yarar mı ?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Satir As Range
If Target.Column = 9 Then
        Set Satir = Range(Cells(Target.Row, "A"), Cells(Target.Row, "T"))
        Select Case Target
            Case "ct", "CT"
                Satir.Copy Worksheets("CT TEZGAHLARI").[a65536].End(3)(2, 1)
                Target.EntireRow.Copy
        End Select
End If
Exit Sub
End Sub

 

[manisali50]

Çalışmadı

Arkadaşım..İlgine tekrar teşekkür ediyorum,ama maalesef verdiğin kodlar çalışmadı..Ben isteğimi belirten dosyayı biraz daha geliştirerek tekrar yolluyorum.

 

[manisali50]

Arkadaşlar merhaba.
Korhan Ayhan üstadımın büyük ilgi ve gayreti ile yaptığım programa ufak bir ilave yapma zorunluluğu doğdu. Yine yardımlarınızı bekliyorum.
Ekteki dosyada Sayfa1'de bulunan CM/CT sütünunda tezfahların CM ya da CT gruplarından hangisine dahil olduğu yazıyor..Benim isteğim şu :
Tezgah CM grubundan ise "CM TEZGAHLARI" sayfasına,CT grubundan ise "CT TEZGAHLARI" sayfasına aktarılması..
Şimdiden teşekkürler.

Arkadaşlar..Ek dosya olarak 8. mesajımdaki dosyanın örnek alınmasını rica ediyorum..

 

[Korhan Ayhan]

Selamlar,

Size önerilen kod Sayfa1 isimli sayfanızın "I" sütununa gireceğiniz bilgiye göre aktarım işlemi yapmaktadır. Yani hücreye girilecek bilgi ile tetiklenmektedir. Sanıyorum siz aktarım işlemini buton ile yapmak istiyorsunuz. Bu durumda aşağıdaki kodu kullanabilirsiniz.

Option Explicit
 
Sub TEZGAHLARI_SAYFALARA_AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim X As Integer, Satır1 As Integer, Satır2 As Integer
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("CT TEZGAHLARI")
    Set S3 = Sheets("CM TEZGAHLARI")
    
    S2.Range("A13:E42,G13:J42").ClearContents
    S3.Range("A13:E42,G13:J42").ClearContents
    Satır1 = 13
    Satır2 = 13
    
    For X = 2 To S1.Range("A65536").End(3).Row
        If Satır1 > 42 Or Satır2 > 42 Then
            MsgBox "Sayfalar doldu !" & Chr(10) & "İşleme devam etmek için lütfen satır ekleyiniz.", vbCritical
            Set S1 = Nothing
            Set S2 = Nothing
            Set S3 = Nothing
            Exit Sub
        End If
        If S1.Cells(X, "I") = "CT" Then
            S2.Cells(Satır1, "A") = S1.Cells(X, 1)
            S2.Range("G" & Satır1 & ":L" & Satır1).Value = S1.Range("C" & X & ":H" & X).Value
            Satır1 = Satır1 + 1
        ElseIf S1.Cells(X, "I") = "CM" Then
            S3.Cells(Satır2, "A") = S1.Cells(X, 1)
            S3.Range("G" & Satır2 & ":L" & Satır2).Value = S1.Range("C" & X & ":H" & X).Value
            Satır2 = Satır2 + 1
        End If
    Next
        
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
        
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[manisali50]

Korhan Hocama söyleyecek tek kelimem var...MUHTEŞEMSİNİZ......Çok çok çok çok çok çok teşekkür ederim.

 

[Civan Jack]

Teşekkürler Korhan Bey buna benzer bir dosyam var biraz revize ederek bende kullanabilirim aslında.