DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub donustur()
Dim i As Long, k As Byte, sat As Long, myarr()
Sheets("DATA").Select
Application.ScreenUpdating = False
sat = 2
myarr = Array("", "A", "B", "C", "D", "E", "F", "G", "H", "I")
With Sheets("Olması gereken")
.Range("A2:D65536").ClearContents
For i = 2 To Cells(65536, "A").End(xlUp).Row
For k = 5 To 9
If Cells(i, k).Value > 0 Then
For z = 1 To Cells(i, k).Value
.Cells(sat, "A").Value = Cells(i, "B").Value
.Cells(sat, "B").Value = Cells(i, "C").Value
.Cells(sat, "C").Value = Cells(i, "D").Value
.Cells(sat, "D").Value = Cells(1, myarr(k)).Value
sat = sat + 1
Next z
End If
Next k
Next i
End With
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır.", vbOKOnly + vbInformation, "E V R E N"
End Sub
Rica ederim.Süpersin Evren Hocam çok teşkekkürler