Mal alış makrosu hk.

[onurbeyaz]

Merhaba üstatlar her gün yaptığımız bir işlem var günlük mal kabulcü arkadaş ekte gönderdiğim exceldeki hammadde giriş kontrolü doldurup bize atıyor bizde muhasebe programına atıyoruz bunu makrolu hale getirmek istiyorum. Hergün sırasıyla 29AĞUSTOS-30AĞUSTOS-31AĞUSTOS sekmeleri açıyor verileri dolduruyor bizde mal aktarım sekmesine = ile çekmeye çalışıyoruz bunu tarih bazlı çektirmemiz mümkün mü?

 

[AdemCan]

Merhaba yazılan tarihe göre sayfalardan bu kodlar ile kayıtları alabilirsiniz.

Sub test()
Dim s1 As Worksheet, s2 As Worksheet
Dim son1 As Long, son2 As Long

Set s2 = Sheets("MAL AKTARIM"): son2 = s2.Cells(Rows.Count, "A").End(3).Row

isim = UCase(Format(s2.Range("J1"), "dmmmm"))

For Each sayfa In Worksheets
    If sayfa.Name = isim Then
        Set s1 = sayfa
        son1 = s1.Cells(Rows.Count, "C").End(3).Row
        GoTo devam
    End If
Next

If s1 Is Nothing Then
    MsgBox isim & " sayfası bulunamadı!", , ""
    GoTo son
End If

devam:

s2.Range("A2:H" & son2 + 1).Clear
For i = 8 To son1
    With s2
        .Cells(i - 6, "A") = s1.Cells(i, "D")
        .Cells(i - 6, "B") = s1.Cells(i, "B")
'        .Cells(i - 6, "C") = s1.Cells(i, "C")
        .Cells(i - 6, "D") = s1.Cells(i, "G")
        .Cells(i - 6, "E") = s1.Cells(i, "H")
        .Cells(i - 6, "F") = s1.Cells(i, "I")
    End With
Next i

son2 = s2.Cells(Rows.Count, "A").End(3).Row
For i = 2 To son2
    With s2
        If .Cells(i, "D") <= 0 Or .Cells(i, "E") <= 0 Or .Cells(i, "F") <= 0 Then
            .Cells(i, "G") = 0
        Else
            .Cells(i, "G") = (.Cells(i, "D") * .Cells(i, "E")) / .Cells(i, "F")
            .Cells(i, "G").NumberFormat = "_-* #,##0.00000_-;-* #,##0.00000_-;_-* ""-""??_-;_-@_-"
        End If
    End With
Next i
son:
End Sub

Not: Kod güncellenmiştir.

 

[onurbeyaz]

Merhaba yazılan tarihe göre sayfalardan bu kodlar ile kayıtları alabilirsiniz.

Sub test()
Dim s1 As Worksheet, s2 As Worksheet
Dim son1 As Long, son2 As Long

Set s2 = Sheets("MAL AKTARIM"): son2 = s2.Cells(Rows.Count, "A").End(3).Row

isim = UCase(Format(s2.Range("J1"), "dmmmm"))

For Each sayfa In Worksheets
aaa = sayfa.Name
    If sayfa.Name = isim Then
        Set s1 = sayfa
        son1 = s1.Cells(Rows.Count, "C").End(3).Row
        GoTo devam
    End If
Next

If s1 Is Nothing Then
    MsgBox isim & " sayfası bulunamadı!", , ""
    GoTo son
End If

devam:

s2.Range("A2:H" & son2 + 1).Clear
For i = 8 To son1
    With s2
        .Cells(i - 6, "A") = s1.Cells(i, "D")
        .Cells(i - 6, "B") = s1.Cells(i, "B")
'        .Cells(i - 6, "C") = s1.Cells(i, "C")
        .Cells(i - 6, "D") = s1.Cells(i, "G")
        .Cells(i - 6, "E") = s1.Cells(i, "H")
        .Cells(i - 6, "F") = s1.Cells(i, "I")
    End With
Next i

son2 = s2.Cells(Rows.Count, "A").End(3).Row
For i = 2 To son2
    With s2
        If .Cells(i, "D") <= 0 Or .Cells(i, "E") <= 0 Or .Cells(i, "F") <= 0 Then
            .Cells(i, "G") = 0
        Else
            .Cells(i, "G") = (.Cells(i, "D") * .Cells(i, "E")) / .Cells(i, "F")
            .Cells(i, "G").NumberFormat = "_-* #,##0.00000_-;-* #,##0.00000_-;_-* ""-""??_-;_-@_-"
        End If
    End With
Next i
son:
End Sub

Not: Kod güncellenmiştir.

Adem Bey çok teşekkür ederim tam istediğim gibi oldu

 

[AdemCan]

Rica ederim.