• DİKKAT

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

Bir rapordan farklı sayfalara veri aktarmak..

E

enogsis

Katılım
27 Şubat 2010
Mesajlar
13
Excel Vers. ve Dili
2003 türkçe
Arkadaşlar merhaba,

6 sayfalık excelim var. 1. sayfanın K2 ve K30000 sutununa 5 veri giriyorum.
Girdiğim bu veriler A-B-C-D-E diyelim.

A seçildiğinde 2. sayfaya
B seçildiğinde 3. sayfaya
C seçildiğinde 4. sayfaya
D seçildiğinde 5. sayfaya
E seçildiğinde 6. sayfaya

veri makro ile veri aktarmak istiyorum,(Eğer ile sistem karışabiliyor) yanlız K2 seçilirken L2 ve D2 hücerelerinide sayfama taşıyacağız, yardımcı olabilir misiniz.
 
Ünlemler kullanmak yerine örnek dosya yüklerseniz neyin hangi sayfanın hangi adresine hücresine satırına neden atılması gerektiği anlaşılır ve nokta atışlı kod yazılabilir.... Altın üye olmanıza gerek yok, dosyayı bir dış servera yükleyip linki burada yayınlayın.
 
Bu aktarım işleminin ne zaman yapılması gerekiyor?
 
rapora veri giriyoruz. diğer sayfalarda yenile butonu var makroda yapmaya çalıştık ona basınlınca her bölüm kendi iş emrini çıkartıyor.

amacımız güncel bir rapordan 5 gruba iş planı hazırlamak ve bunların tamamlanıp tamamlanmadığını takip etmek
 
Dosyanızda ;

1-Dış bağlantılar var , bunlar masaüstünde başka dosyalara uzantı almış durumda ve sebebi belirsiz. O dosyalar yok.
2-Dosyanız 4 mb boyutunda ve sebebi sayfalarda sadece hücre çizgileri sayfa sonuna kadar yani 1 050 000 satır.
3-Şu sayfaya atılacak dediğiniz sayfalar kaldırılmış ve olsa da neresine atılacağı belirsiz.
4-Stokta bulunup bulunmadığının tesbiti ve stokta yoksa , ayrıca parça tanımı ya da varsa numara ya da özelliği belirsiz.
5-Sayfaların hepsinde , gönderdiğiniz örnekte olmayan süzgeç adları var.

Tam ne istediğinizi şahsım adına anlamış değilim, dosya da anlatamayacak durumda budanmış .
 
anlaşılmayacak ne var anlamadım, bir hücrede 5 farkılı veri var hangisini seçersem aynı isimli sayfaya yanındaki hücreye girilen notu gönderecek.

ünleme takıyorsunuz, altın üyelikten bahsediyorsunuz, İLGİNÇ !!
 
VARDİYA RAPORU sayfasındaki hangi sütunlar diğer sayfalara aktarılacak?

Sütun eşleştirmelerini yazabilir misiniz?

Hazırladığım kodu ekliyorum. Gerekirse düzenleriz.

Kod: 
Option Explicit

Sub Sayfalara_Aktar()
    Dim S1 As Worksheet, X As Long, Son As Long, S2 As Worksheet, Satir As Long, Sayfa As Variant
    
    Set S1 = Sheets("VARDİYA RAPORU")
    
    On Error Resume Next
    S1.ShowAllData
    On Error GoTo 0
    
    Son = S1.Cells(Rows.Count, "K").End(3).Row
    
    Sayfa = Array("haftalık bakım", "aylık bakım", "yıllık bakım", "3 aylık bakım", "6 aylık bakım")
    
    For X = 0 To UBound(Sayfa)
        Set S2 = Sheets(Sayfa(X))
        On Error Resume Next
        S2.ShowAllData
        On Error GoTo 0
        S2.Range("A3:F" & Rows.Count).ClearContents
    Next
        
    For X = 2 To Son
        Select Case LCase(S1.Cells(X, "K"))
            Case "haftalık bakım", "aylık bakım", "yıllık bakım", "3 aylık bakım", "6 aylık bakım"
                Set S2 = Sheets(LCase(S1.Cells(X, "K")))
                On Error Resume Next
                S2.ShowAllData
                On Error GoTo 0
                
                Satir = S2.Cells(Rows.Count, 1).End(3).Row + 1
                S2.Cells(Satir, 1) = S1.Cells(X, 12)
                S2.Cells(Satir, 2) = S1.Cells(X, 1)
                S2.Cells(Satir, 3) = S1.Cells(X, 4)
                S2.Cells(Satir, 4) = S1.Cells(X, 10)
        End Select
    Next

    MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub
 
Tamda makroya küsmüştük hocam ilginiz için sağolun

https://dosya.co/o8nsvw5fv4ip/vardiya_son_deneme.xlsm.html

ekteki dosyada makronun yapması gerekeni munel yaptım.
vardiya raporu sayfasında K2 sutununda "Yedek parça" seçilirse
L2 sutununda yazılan>> Yedek parça A3 sutununa otomatik aktarılacak,
yanına b3 tarih C3 vardiya şefi adı da aktarılacak

teknik çizim
vizyon
yrd. işletme
haftalık bakım içinde aynı döngü ğeçerli olacaktır. TEŞEKKÜRLER.
 
Verdiğiniz kodu denedim haftalık ve yıllık bakım tam istediğim mantıkta.
diğerleri için for döngüsünü mü artırmamız gerekiyor.
 
Açılır listenizde aşağıdaki seçenekler var.

Kırmızı renkli seçimler hangi sayfaya aktarılacak?

Arıza
Bakım
Yedek Parça (Bu sayfa var)
Teknik Çizim (bu sayfa var)
Vizyon (Bu sayfa var)
Haftalık Bakım (Bu sayfa var)
Yrd. İşletme (Bu sayfa var)
 
hocam bunlar bilgilendirme amaçlı, herhangi bir yere taşımıcam
vs vs vs oldu arıza
vs vs vs oldu bakım
 
Aşağıdaki kodu deneyiniz.

Kod: 
Option Explicit

Sub Sayfalara_Aktar()
    Dim Zaman As Double, S1 As Worksheet, Sayfalar As Object
    Dim Son As Long, Veri As Variant, X As Long, Sayfa_Adi As Variant
    Dim Sayfa As Variant, S2 As Worksheet, Aranan As String, Satir As Long
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Zaman = Timer
   
    Set S1 = Sheets("VARDİYA RAPORU")
    Set Sayfalar = CreateObject("Scripting.Dictionary")
   
    Son = S1.Cells(Rows.Count, 1).End(3).Row
   
    Veri = S1.Range("A2:L" & Son).Value
   
    For X = 1 To UBound(Veri)
        If Veri(X, 11) <> "" Then Sayfalar(Veri(X, 11)) = 1
    Next
   
    Sayfa_Adi = Array("Yedek Parça Listesi", "Teknik Çizim İş Listesi", "Vizyon İş Listesi", "Yrd. İşletme İş Listesi", "Haftalık Bakım İş Listesi")
   
    ReDim Liste(1 To UBound(Veri), 1 To 3)
   
    For Each Sayfa In Sayfalar.Keys
        For X = 0 To UBound(Sayfa_Adi)
            If Sayfa <> "Arıza" And Sayfa <> "Bakım" Then
                If InStr(1, Sayfa_Adi(X), Sayfa) > 0 Then
                    Set S2 = Sheets(Sayfa_Adi(X))
                    Exit For
                End If
            End If
        Next
       
        On Error Resume Next
        S2.ShowAllData
        On Error GoTo 0
       
        Aranan = Sayfa
       
        For X = 1 To UBound(Veri)
            If Sayfa <> "Arıza" And Sayfa <> "Bakım" Then
                If Veri(X, 11) = Aranan Then
                    Satir = Satir + 1
                    Liste(Satir, 1) = Veri(X, 12)
                    Liste(Satir, 2) = Veri(X, 1)
                    Liste(Satir, 3) = Veri(X, 4)
                End If
            End If
        Next
       
        If Satir > 0 Then
            S2.Range("A3:C" & Rows.Count).ClearContents
            S2.Range("A3:C" & Satir + 2).Value = Liste
            Set S2 = Nothing
            Satir = 0
        End If
    Next
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - Zaman), "0.00") & " saniye"
End Sub
 
Vardiya raporu yedek parça (K2) seçili alan makro sonrası yedek parça sayfasına geçiyor. L2
ancak aynı satır (K2) arızaya çevirilirse, yedek parça sayfadaki veri geri gitmiyor.
 
Seçim değişirse aktarım işlemini yeniden yapmalısınız.
 
hocam yarın güzel bir dosya paylaşacağım sizinle, ilk kod üzerinde bişeyler yaptım.
emeğinize sağlık size tekrar ulaşıcam.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst