• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Yeni açılan sayfalara kodların ilavesi

M

manisali50

Banned
Katılım
29 Ekim 2010
Mesajlar
471
Excel Vers. ve Dili
Excel2003
Arkadaşlar tekrar merhaba.
Yine bu forumdaki üstadların ilgi ve gayretleri ile oluşturduğum tezgah bakım analizi klasörüme birkaç sayfa daha ilave etmem gerekecek..
Daha önceden sadece CT ve CM tezgahları sayfam vardı.Bunlara ilaveten TM ve TG sayfaları ilave edeceğim.(İleride başka sayfalar da ilave olabilir.) Bunların kodlarına hangi satırları ilave etmeliyim??
Şimdiden teşekkürler..
 

Ekli dosyalar

Özür dilerim arkadaşlar ...Şifreyi silmeyi unutmuşum..Şifre : 8996
 
Son düzenleme:
Ardaşalra bu gece görürsem işimi çok iyi olacak benim için..Ölme çok zor olduğunu tahmin etmiyorum ama,bilmedikten sonra hepsi zor işte..
 
Gündüz yanıt veren üstad olmamış..Bu gece yanıt alacağıma inanıyorum
 
Hergün sayfamı tazeliyorum..324 kişi incelemesine rağmen uzun bir süredir yanıt alamadım..Grafik sorumla beraber ilgilenirseniz sevinirim üstadlarım.
 
Selamlar,

Siz dosyanıza sayfa ekledikçe nasıl bir işlem olmasını istiyorsunuz detaylıca açıklarmısınız. Ayrıca dosyanızın şifresiz halini foruma eklerseniz daha iyi olur.
 
Hocam tekrar merhaba..Elimdeki dosyada sadece 2 sayfa var..(CT ve CM Tezgahları sayfaları) ileride bunlara birkaç sayfa daha ilave edilecek.. Klasörün içindeki Sayfa1'de yazılı kodlara bu yeni açılan sayfaları nasıl ilave edeceğim?Sayfa1'i doldurduktan sonra "Tezgah Sayfalarına AKTAR" butonuna bastığımda bu yeni açılan sayfalara da veri aktarımını nasıl gerçekleştireceğim?
 
Selamlar,

Bu dosyanızda aktarımı yapılmayacak başka sayfalar olacakmı?
 
CT ve CM Tezgahları sayfalarından sonra en az 5-6 sayfa daha ilave edilecek ve hepsine de "Tezgah sayfalarına aktar" butonu ile veri aktarılacak.
 
Selamlar,

Aşağıdaki koddaki kırmızı renkli bölümü mavi renkli bölümün üstüne kopyalayarak ihtiyacınız kadar çoğaltın. Sanıyorum kendinize uyarlayabilirsiniz.

Kod: 
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:E42,G13:J42").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("A44").End(3).Row + 1
                    If Satır = 43 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("G" & Satır & ":L" & 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("A44").End(3).Row + 1
                    If Satır = 43 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("G" & Satır & ":L" & 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("A44").End(3).Row + 1
                    If Satır = 43 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("G" & Satır & ":L" & Satır).Value = S1.Range("C" & X & ":H" & X).Value
                End If
            End If
 
[COLOR=red]           If Left(Sayfa.Name, 2) = "TG" Then[/COLOR]
[COLOR=red]               If S1.Cells(X, "I") = "TG" Then[/COLOR]
[COLOR=red]                   Satır = Sayfa.Range("A44").End(3).Row + 1[/COLOR]
[COLOR=red]                   If Satır = 43 Then[/COLOR]
[COLOR=red]                       MsgBox "Satırlar doldu !" & Chr(10) & "İşleme devam etmek için lütfen satır ekleyiniz.", vbCritical[/COLOR]
[COLOR=red]                       Set S1 = Nothing[/COLOR]
[COLOR=red]                       Exit Sub[/COLOR]
[COLOR=red]                   End If[/COLOR]
[COLOR=red]                   Sayfa.Cells(Satır, "A") = S1.Cells(X, 1)[/COLOR]
[COLOR=red]                   Sayfa.Range("G" & Satır & ":L" & Satır).Value = S1.Range("C" & X & ":H" & X).Value[/COLOR]
[COLOR=red]               End If[/COLOR]
[COLOR=red]           End If[/COLOR]
        [COLOR=blue]Next[/COLOR]
    Next
 
    Set S1 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Hocam çok teşekkür ederim...Grafik sorunumu da hallettiniz mi tamamdır Allah'ın izniyle..Tekrar teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst