dolu olan değerleri aktar

[zodiak]

sayın hocalarım Günlük sayfasından dolu olan verileri aktar butonu ve form dan seçilen tarihe ve isteğe göre verileri aktarıp yeni bir sayfa yada liste adında sabit bir sayfaya kopyalaya biliyoruz kodun çalışmasında hiç bir sıkıntı yok Ancak Günlük sayfası c ve d sutunları arasına bir yeni sutun ekleyip bu sutunuda kodla birlikte liste yada yeni oluşturulan sayfalara aktarmak istiyorum ayrıca günlük sayfasında f2 hücresinnin içeriğinide tarih yazan sutun gibi aktarmak istiyorum ancak yapamıyorum yardımcı olursanız çok sevinirim ...

 

[zodiak]

yok mu çaresi dostlar Fesuphan Allah bakan kimse yok mu ...

 

[Korhan Ayhan]

Merhaba,

Neden C-D sütunları arasına sütun ekliyorsunuz.

 

[zodiak]

korhan hocam oraya malzemenin birimi gelecek örneğin adet kilo deste gram gibi ve listedede görünmesi gerekiyor bu örnek aslında bir ambar çıkış pusulası yani üretimde kullanılan malzemelerin listesi ve her gün için ayrı bir pusula yapılıyor ve örnekteki 101 102 v.s o pusulanın numarası onuda günlük sayfasında tarihin yanından almamız gerekiyor umarım açıklayıcı olmuştur. saygılarımla

 

[Korhan Ayhan]

Merhaba,

Formunuzdaki kodları silip aşağıdaki kodları uygularmısınız.

Private Sub ListBox1_Click()
    Label3 = ListBox1.Text
    CommandButton1.Enabled = False
    If Label3 <> "" Then CommandButton1.Enabled = True
End Sub
 
Private Sub UserForm_Activate()
    Dim X As Byte
 
    For X = 1 To 31
        ListBox1.AddItem Format(Cells(2, X * 2 + 3).Value, "dd.mm.yyyy")
    Next
End Sub
 
Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, X As Integer, Satır As Integer, Gün As String
 
    Set S1 = Sheets("Liste1")
    S1.Cells.EntireRow.Hidden = False
    S1.Range("A4:F257").ClearContents
 
    Satır = 4
    Sütun = Rows(2).Find(CDate(ListBox1.Text)).Column
 
    S1.Range("E2") = Cells(2, Sütun)
    S1.Range("F2") = Cells(2, Sütun + 1)
 
    For X = 4 To 180
        If Cells(X, 3) > 0 Then
            If Cells(X, Sütun) <> 0 Then
                S1.Cells(Satır, 1) = Cells(X, 1)
                S1.Cells(Satır, 2) = Satır - 3
                S1.Cells(Satır, 3) = Cells(X, 3)
                S1.Cells(Satır, 4) = Cells(X, 4)
                S1.Cells(Satır, 5) = Cells(X, Sütun)
                S1.Cells(Satır, 6) = Cells(X, Sütun + 1)
                Satır = Satır + 1
            End If
        End If
    Next
 
    S1.Rows(Satır & ":257").EntireRow.Hidden = True
 
    If OptionButton2 = True Then
        Gün = Mid(ListBox1.Text, 1, 2) + "-" + Mid(ListBox1.Text, 4, 2)
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets(Gün).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        Sheets("Liste1").Copy After:=Sheets(ThisWorkbook.Worksheets.Count)
        ActiveSheet.Name = Gün
    End If
 
    Unload Me
    Set S1 = Nothing
 
    MsgBox "Ambar çıkış pusulası hazırlanmıştır.", vbInformation
End Sub

 

[zodiak]

kdrhan hocam hakkınızı helal ediniz lütfen yine çok güzel olmuş ellerinize sağlık

bu arad bende bir önceki kod üstünde çalışıyordum ama sizin verdiğiniz kod hem daha güzel hemde daha aydınlatıcı işin mantığını kavramaya çalışıyorum sayenizde

 

[zodiak]

Korhan hocam verdiğiniz kod çalışıyor ancak ekteki dosyayı açınca göreceğiniz üzre üç adet çalışma sayfası birbirine veri alış verişi yapıyor bu kodu çalıştırdığım zaman hata veriyor sizden rica etsem nerede yanlışlık var bir göz atabilir misiniz.
bu projem bitince bunu kullanırken aynı işi yapacak bir proğramı access te yapmayı düşünüyorum saygılarımla

 

[zodiak]

yok mu yardım edecek kimse ?

 

[zodiak]

sayın hocalarım varsa bir çaresi bir ip ucu verseniz belki cözerim ama tıkandım kaldım yardımınıza ihtiyacım var

 

[zodiak]

sanırım yok bir çaresi

 

[Korhan Ayhan]

Merhaba,

Sorduğunuz soruların elbette çözümü var. Fakat sorularınızın detayları bizleri yönlendiriyor. Size cevap verdikten sonra diyorsunuz ki 3 dosya birbiriyle bağlantılı çalışıyor. Bu detayları sorunuzu ilk mesajınızda yazarken açıklamanız size verilecek cevaplarında daha net olmasını sağlayacaktır.

Aşağıdaki şekilde denermisiniz. Yapılan değişiklikleri kırmızı renkle belirttim.

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, X As Integer, Satır As Integer, Gün As String
 
    Set S1 = Sheets("Liste1")
    S1.Cells.EntireRow.Hidden = False
    S1.Range("A4:F257").ClearContents
 
    Satır = 4
[COLOR=red]    Sütun = Rows(2).Find(Format(CDate(ListBox1.Text), "dd mmmm yyyy dddd"), , xlValues).Column
 
    S1.Range("E2") = Format(Cells(2, Sütun), "dd mmmm yyyy dddd")
[/COLOR]    S1.Range("F2") = Cells(2, Sütun + 1)
 
    For X = 4 To 180
        If Cells(X, 3) > 0 Then
            If Cells(X, Sütun) <> 0 Then
                S1.Cells(Satır, 1) = Cells(X, 1)
                S1.Cells(Satır, 2) = Satır - 3
                S1.Cells(Satır, 3) = Cells(X, 3)
                S1.Cells(Satır, 4) = Cells(X, 4)
                S1.Cells(Satır, 5) = Cells(X, Sütun)
                S1.Cells(Satır, 6) = Cells(X, Sütun + 1)
                Satır = Satır + 1
            End If
        End If
    Next
 
    S1.Rows(Satır & ":257").EntireRow.Hidden = True
 
    If OptionButton2 = True Then
        Gün = Mid(ListBox1.Text, 1, 2) + "-" + Mid(ListBox1.Text, 4, 2)
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets(Gün).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        Sheets("Liste1").Copy After:=Sheets(ThisWorkbook.Worksheets.Count)
        ActiveSheet.Name = Gün
    End If
 
    Unload Me
    Set S1 = Nothing
 
    MsgBox "Ambar çıkış pusulası hazırlanmıştır.", vbInformation
End Sub

 

[zodiak]

korhan hocam haklısınız ama dosyayı açtığınızda da görmüşünüzdür üçü birlikte açılınca baya bir pc yi kasıyor ben o yüzden ilk mesajımda projenin bir kısmını vermiştim bazı arkadaşlar bu durumdan rahatsız oluyorlar o bakımdan yoksa elbette projenin bütünün paylaşmaya ve yaşadığım sorunları anlatmaya muktedirim bu konuda da anlayışınıza sığınıyorum saygılarımla

 

[Korhan Ayhan]

Ben dosyalarınızı neden paylaşmıyorsunuz demiyorum. En azından birbiriyle bağlantılı dosyalar kullanıyorum ve tarihler formüller aracılığı ile gelmektedir açıklaması bile size verilecek cevapları yönlendirecektir.

 

[zodiak]

hocam anladım daha dikkatli olmaya özen göstereceğim