• DİKKAT

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

makroyu ekteki dosyaya uyarlamak

  • Konbuyu başlatan Konbuyu başlatan tchsyn
  • Başlangıç tarihi Başlangıç tarihi
Katılım
10 Ekim 2007
Mesajlar
31
Excel Vers. ve Dili
exell2007
merhaba, aşağıdaki makroyu ekteki dosya için sağlıklı çalıştıramıyorum.
derdim şu sheet1 deki formatımız var. bu formatı sheet2 ye sheet3e yaptıgım dizaynda gelmesini istiyorum. yardım lütfen.



Sub hizmet()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
For j = 10 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) = s1.Range("B" & I & ":H" & I).Value
s2.Range("I" & ss & ":L" & ss) = Range(s1.Cells(I, j), s1.Cells(I, j + 3)).Value
s2.Cells(I, 13) = Format(s2.Cells(I, "K").Value, "hh:mm")
s2.Cells(I, 14) = Format(s2.Cells(I, "L").Value, "hh:mm")
B1 = Trim(Cells(I, "D").Value)
B2 = Trim(Cells(I, "G").Value)
B3 = Trim(Cells(I, "j").Value)
B4 = Format(Cells(I, "K").Value, "hh:mm")
B5 = Format(Cells(I, "L").Value, "hh:mm")
B6 = Trim(Cells(I, "C").Value)
s2.Cells(I, 1) = B1 + B2 + B3 + B4 + B5 + B6
Atla:
Next
Next
MsgBox "İşlem Tamamlandı"
End Sub
 

Ekli dosyalar

Öncelikle konu başlığınıza forum kurallarına uygun bir çare bulmanız lazım.
 
bir akıl verecek usta yokmu?
 
Geri
Üst