Grafik sorunum

[manisali50]

Arkadaşlar merhaba..
Korhan üstadımın üstün gayret ve yardımlarıyla bu dosyaları hazırladım..
Bunlara güzellik eklemek istedim ve “Tezgah Bakım Analizi” klasörünün içindeki “CM TEZGAHLARI” ve “CT TEZGAHLARI” sayfalarının içine grafik eklemeye çalıştım..Ancak grafik bir türlü işlevini görmüyordu..Sınama-yanılma sonucu hatanın hücre birleştirmelerinden kaynaklandığını buldum..Hücreleri tek hücre haline dönüştürdüm ve grafik çalışmaya başladı..Bu sefer de kodlar değiştiği için “Tezgah sayfalarına aktar” butonu işlevini yitirdi..Buradan öğrendiğim bilgilerle kodları düzenledim ve “Sayfa1”deki arıza sebeplerini “Tezgah sayfalarına aktar” butonu ile CM TEZGAHLARI ve CT TEZGAHLARI sayfalarına ayrıştırmayı başardım..Gelin görün ki aksilikler bununla da bitmedi..Bu sefer de “Sayfa1” sayfasındaki “Analizleri Listele” butonu işlevini yitirmiş ve “Tezgah sicil kartı ve arıza bildirim formu” klasöründen bilgileri bu sayfaya aktarmıyordu..Neler yaptıysam işin içinden çıkamadım ve sonunda üstadlarıma başvurmaya karar verdim..2 dosya da ektedir..Yardımlarınızı bekliyorum..Şimdiden teşekkürler

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu deneyiniz.

Dikkat ediyorum sürekli tablolarınızı değiştiriyorsunuz. Durmadan önerdiğimiz kodları güncellemek zorunda kalıyoruz. Bunlar bizlere zaman kaybına yol açmaktadır. Tablolarınızı uygun şekilde tasarladıktan sonra sorularınızı sorarsanız bizlerde boşuna uğraşmış olmayız.

Option Explicit
 
Sub TEZGAHLARI_SAYFALARA_AKTAR()
    Dim S1 As Worksheet, Sayfa As Worksheet
    Dim X As Integer, Satır As Integer
 
    Set S1 = Sheets("Sayfa1")
 
    For Each Sayfa In ThisWorkbook.Worksheets
        Sayfa.Range("A13:A34,C13:F34").ClearContents
    Next
 
    For X = 2 To S1.Range("A100").End(3).Row
        For Each Sayfa In ThisWorkbook.Worksheets
            If Left(Sayfa.Name, 2) = "CT" Then
                If S1.Cells(X, "I") = "CT" Then
                    Satır = Sayfa.Range("A35").End(3).Row + 1
                    If Sayfa.Range("A34") <> "" Then
                        MsgBox "Satırlar doldu !" & Chr(10) & "İşleme devam etmek için lütfen satır ekleyiniz.", vbCritical
                        Set S1 = Nothing
                        Exit Sub
                    End If
                    Sayfa.Cells(Satır, "A") = S1.Cells(X, 1)
                    Sayfa.Range("C" & Satır & ":H" & Satır).Value = S1.Range("C" & X & ":H" & X).Value
                End If
            End If
 
            If Left(Sayfa.Name, 2) = "CM" Then
                If S1.Cells(X, "I") = "CM" Then
                    Satır = Sayfa.Range("A35").End(3).Row + 1
                    If Sayfa.Range("A34") <> "" Then
                        MsgBox "Satırlar doldu !" & Chr(10) & "İşleme devam etmek için lütfen satır ekleyiniz.", vbCritical
                        Set S1 = Nothing
                        Exit Sub
                    End If
                    Sayfa.Cells(Satır, "A") = S1.Cells(X, 1)
                    Sayfa.Range("C" & Satır & ":H" & Satır).Value = S1.Range("C" & X & ":H" & X).Value
                End If
            End If
 
            If Left(Sayfa.Name, 2) = "TM" Then
                If S1.Cells(X, "I") = "TM" Then
                    Satır = Sayfa.Range("A35").End(3).Row + 1
                    If Sayfa.Range("A34") <> "" Then
                        MsgBox "Satırlar doldu !" & Chr(10) & "İşleme devam etmek için lütfen satır ekleyiniz.", vbCritical
                        Set S1 = Nothing
                        Exit Sub
                    End If
                    Sayfa.Cells(Satır, "A") = S1.Cells(X, 1)
                    Sayfa.Range("C" & Satır & ":H" & Satır).Value = S1.Range("C" & X & ":H" & X).Value
                End If
            End If
 
            If Left(Sayfa.Name, 2) = "TG" Then
                If S1.Cells(X, "I") = "TG" Then
                    Satır = Sayfa.Range("A35").End(3).Row + 1
                    If Sayfa.Range("A34") <> "" Then
                        MsgBox "Satırlar doldu !" & Chr(10) & "İşleme devam etmek için lütfen satır ekleyiniz.", vbCritical
                        Set S1 = Nothing
                        Exit Sub
                    End If
                    Sayfa.Cells(Satır, "A") = S1.Cells(X, 1)
                    Sayfa.Range("C" & Satır & ":H" & Satır).Value = S1.Range("C" & X & ":H" & X).Value
                End If
            End If
        Next
    Next
 
    Set S1 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[manisali50]

Hocam çok çok teşekkür ederim..Söylediklerinizde çok haklısınız..Ama bu işte yeni olduğumuz için hergün yeni bir şey çıkıyor karşıma ona göre değiştirmek zorunda kalıyorum..Gerçekten özür dilerim..Bundan sonra dikkat ederim..İyi geceler diliyor,sevgi ve saygılarımı sunuyorum