Sayfaya Aktarma

[bayteksan]

Sayın Meslan,
kusura bakmayın be 53 yaşımda biriyim.Anlayışınıza sığınıyorum ben sizler kadar profesyonel değilim.Kendimi yetiştirmek istiyorum.Bir eksiklik daha var BAKİYE kısmını aktarmıyor.Vede aktardıktan sonra biçimlendirdiğim biçim yeniden YTL oluyor.Yardımlarınız için tekrar teşekkürler ediyorum.Kolay gelsin..

 

[meslan]

Sayın Meslan,
kusura bakmayın be 53 yaşımda biriyim.Anlayışınıza sığınıyorum ben sizler kadar profesyonel değilim.Kendimi yetiştirmek istiyorum.Bir eksiklik daha var BAKİYE kısmını aktarmıyor.Vede aktardıktan sonra biçimlendirdiğim biçim yeniden YTL oluyor.Yardımlarınız için tekrar teşekkürler ediyorum.Kolay gelsin..

Sub AKTAR()
    Dim S1, S2 As Object
    Dim SAY, X, SATIR As Long
    Set S1 = Sheets("VERİ")
    Set S2 = Sheets("RAPOR")
    S2.[A:E].ClearContents
    If S1.[H1] = "" Then
    MsgBox "AKTARIM İŞLEMİ İÇİN LÜTFEN FİRMA SEÇİNİZ !", vbCritical, "DİKKAT !"
    S1.[H1].Select
    Exit Sub
    End If
    SAY = WorksheetFunction.CountIf(S1.[B:B], S1.[H1])
    If SAY = 0 Then
    MsgBox "AKTARMAK İSTEDİĞİNİZ FİRMA KAYITLARDA BULUNAMAMIŞTIR !", vbExclamation, "UYARI !"
    Exit Sub
    End If
     S2.Range("A1:F1") = S1.Range("A1:F1").Value
    SATIR = 2
    For X = 2 To S1.[A65536].End(3).Row
    If S1.Cells(X, 2) = S1.[H1] Then
    S2.Range("A" & SATIR & ":F" & SATIR) = S1.Range("A" & X & ":F" & X).Value
    SATIR = SATIR + 1
    End If
    Next
    S2.Cells.EntireColumn.AutoFit
    S2.[A:C].HorizontalAlignment = xlLeft 'Sola dayalı - xlCenter> ortalanmış
    S2.[D:D].Style = "comma"
    S2.[E:E].Style = "comma" ' "Currency">  YTL biçimi
    S2.[F:F].Style = "comma"
    Set S1 = Nothing
    Set S2 = Nothing
    MsgBox "AKTARIM İŞLEMİ TAMAMLANMIŞTIR.", vbInformation
End Sub

Sanırım Bu şekilde istediğiniz olmuştur.
Kolay gelsin.

 

[bayteksan]

Sayın meslan arkadaşım bana yardımcı olduğun için teşekkür ederim hiç olmazsa hücrlerdeki veriyi sağa yaslamayı öğrendim. Sağolunuz..Ama sizi benim için fazla yormak beni üzer..Sizden daha fazla istemekten utanıyorum..Ellerinize sağlık.Sadece size problemin olduğu kısmı blirtmekle yetineceğim..Artık size bırakıyorumm.Sizi fazla meşgul etmek istemiyorum..Dosyayı tekrar gönderiyorum BAKİYE kısmı formule edilmemiş.Bunu belirtmek istedim.teşekkürler ediyorum..Kolay gelsin...

 

[meslan]

Sayın meslan arkadaşım bana yardımcı olduğun için teşekkür ederim hiç olmazsa hücrlerdeki veriyi sağa yaslamayı öğrendim. Sağolunuz..Ama sizi benim için fazla yormak beni üzer..Sizden daha fazla istemekten utanıyorum..Ellerinize sağlık.Sadece size problemin olduğu kısmı blirtmekle yetineceğim..Artık size bırakıyorumm.Sizi fazla meşgul etmek istemiyorum..Dosyayı tekrar gönderiyorum BAKİYE kısmı formule edilmemiş.Bunu belirtmek istedim.teşekkürler ediyorum..Kolay gelsin...

Gerekli düzenlemyi yaptım.

Sub AKTAR()
    Dim S1, S2 As Object
    Dim SAY, X, SATIR As Long
    Set S1 = Sheets("VERİ")
    Set S2 = Sheets("RAPOR")
    S2.[A:E].ClearContents
    If S1.[H1] = "" Then
    MsgBox "AKTARIM İŞLEMİ İÇİN LÜTFEN FİRMA SEÇİNİZ !", vbCritical, "DİKKAT !"
    S1.[H1].Select
    Exit Sub
    End If
    SAY = WorksheetFunction.CountIf(S1.[B:B], S1.[H1])
    If SAY = 0 Then
    MsgBox "AKTARMAK İSTEDİĞİNİZ FİRMA KAYITLARDA BULUNAMAMIŞTIR !", vbExclamation, "UYARI !"
    Exit Sub
    End If
     S2.Range("A1:F1") = S1.Range("A1:F1").Value
    SATIR = 2
    For X = 2 To S1.[a65536].End(3).Row
    If S1.Cells(X, 2) = S1.[H1] Then
    S2.Range("A" & SATIR & ":F" & SATIR) = S1.Range("A" & X & ":F" & X).Value
    SATIR = SATIR + 1
    End If
    Next
    S2.Cells.EntireColumn.AutoFit
    S2.[A:C].HorizontalAlignment = xlLeft 'Sola dayalı - xlCenter> ortalanmış
    S2.[D:D].Style = "comma"
    S2.[E:E].Style = "comma" ' "Currency">  YTL biçimi
    
    For i = 2 To S2.[a65536].End(3).Row
    deg = deg + S2.Cells(i, 4).Value - S2.Cells(i, 5).Value
    S2.Cells(i, 6).Value = deg
    Next
    S2.[F:F].Style = "comma"
    Set S1 = Nothing
    Set S2 = Nothing
    MsgBox "AKTARIM İŞLEMİ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[bayteksan]

Sayın meslan arkadaşım bana yardımcı olduğun için teşekkür ederim.Allah yolunu açık etsin emeğine sağlık..