Merhaba başta tüm forum üylerine iyi hafta sonları dilerim.
Benim sorunum 2 haftalık görev listesi oluşturmaya çalışıyorum 1 haftalık olarak yaptım fakat 2 haftalık olan bir türlü olmuyor sizden ricam yardımcı olabilirseniz çok sevinirim 52 haftalık görev listesi yapma ödevim var nerelerde hata yaptıgımı bulamıyorum.
Exceli yüklemek istiyordum fakat resimleride excelide yüklemeyi beceremedim.
Yardımcı olursanız sevinirim
İyi Çalışmalar...
Benim sorunum 2 haftalık görev listesi oluşturmaya çalışıyorum 1 haftalık olarak yaptım fakat 2 haftalık olan bir türlü olmuyor sizden ricam yardımcı olabilirseniz çok sevinirim 52 haftalık görev listesi yapma ödevim var nerelerde hata yaptıgımı bulamıyorum.
Kod:
Sub doit()
Dim DataRange As Range ' Could also be Dim DataRange as Object
Dim row(1) As Long
Dim MaxRows As Long
Dim col As Integer
Dim MaxCols As Long
'Dim MyVar As Double
Worksheets("Görev Listesi").Range("B6:D500").Select
Selection.ClearContents
MsgBox "Görev detayi sütununu kendiniz siliniz"
MaxRows = Worksheets("Haftalik Is Dagilimi").Range("B65536").End(xlUp).row
'MaxRows = Range(“B1”).CurrentRegion.Rows.Count
'MaxCols = Range(“A1”).CurrentRegion.Columns.Count
k = 6
For col = 1 To 7
For row(1) = 8 To 12
Worksheets("Görev Listesi").Cells(k, 2).Value = Worksheets("Haftalik Is Dagilimi").Cells(7, col + 2).Value
Worksheets("Görev Listesi").Cells(k, 3).Value = Worksheets("Haftalik Is Dagilimi").Cells(row(1), 2).Value
Worksheets("Görev Listesi").Cells(k, 4).Value = Worksheets("Haftalik Is Dagilimi").Cells(row(1), col + 2).Value
k = k + 1
Next row(1)
Next col
MaxRows2 = Worksheets("Görev Listesi").Range("B65536").End(xlUp).row
U = 6
Do
ara = "D" & U
If Worksheets("Görev Listesi").Range(ara) = "" Then
rowS(U).Select
Selection.Delete Shift:=xlToUp
MaxRows2 = Worksheets("Görev Listesi").Range("B65536").End(xlUp).row
U = U - 1
End If
U = U + 1
Loop While U <= MaxRows2
End SubYardımcı olursanız sevinirim
İyi Çalışmalar...
