Excel Tablosu için acil yardım

[tchsyn]

Arkadaşlar ekte ornek dosyam var. Sheet 1 de bir kişi 3 adet hizmet alıyor. A hizmeti, Bhizmeti, Chizmeti. bu verileri gün sonunda sheet 2 ye Hizmet bazında Alt alta otomatık aktarmam lazım. sabit alan tum hızmetlerde kullanılmak uzere, A, B, C hizmeti hepsini alt alta getirmek istiyorum. Hergün hizmet alan kişi sayısı değişmekte. nasıl bir makro yazabilirim dosyayı ınceleyip yardımcı olurmusunuz?

 

[tchsyn]

Bu konuda bir üstad yokmudur yardım edebilicek??

 

[dEdE]

Merhaba,
Aşağıdaki kodu Modüle yapıştırıp dener misiniz?

Sub HizmetBirleştir()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
For j = 9 To 20 Step 4
    For i = 3 To s1.Cells(Rows.Count, j).End(3).Row
        ss = s2.Range("B" & Rows.Count).End(3).Row + 1
        s2.Range("B" & ss & ":H" & ss).Value = s1.Range("B" & i & ":H" & i).Value
        s2.Range("I" & ss & ":L" & ss).Value = s1.Range(s1.Cells(i, j), s1.Cells(i, j + 3)).Value
    Next
Next
    MsgBox "İşlem Tamamlandı", vbInformation, "dEdE " & Application.UserName & "'e Başarılar diler."
End Sub

 

[tchsyn]

çok teşekkür ederim oldu. fakat saat bilgisi olmayan verileri alma deme imkanımız varmı?

 

[dEdE]

çok teşekkür ederim oldu. fakat saat bilgisi olmayan verileri alma deme imkanımız varmı?

Merhaba,

Sub HizmetBirleştir()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
For j = 9 To 20 Step 4
    For i = 3 To s1.Cells(Rows.Count, j).End(3).Row
    If s1.Cells(i, j + 1).Value = "" Then GoTo Atla
        ss = s2.Range("B" & Rows.Count).End(3).Row + 1
        s2.Range("B" & ss & ":H" & ss).Value = s1.Range("B" & i & ":H" & i).Value
        s2.Range("I" & ss & ":L" & ss).Value = s1.Range(s1.Cells(i, j), s1.Cells(i, j + 3)).Value
Atla:
    Next
Next
    MsgBox "İşlem Tamamlandı", vbInformation, "dEdE " & Application.UserName & "'e Başarılar diler."
End Sub