DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub makrolu_cozum()
Set s1 = Sheets("ORJINAL")
For i = 5 To 1000
For k = 10 To 12
If s1.Cells(i, k).Value <> "" Then s1.Cells(i, 13).Value = s1.Cells(i, k).Value
Next
Next
End Sub
Sub Aktar()
Dim Rng As Range, _
Hcr As Range, _
Son As Long, _
Adt As Integer
Son = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set Rng = Range("J4:L" & Son)
For Each Hcr In Rng
If Not Hcr.MergeCells > 1 And Not Hcr = "" Then
Adt = Adt + 1
Hcr.Copy Range("M" & Hcr.Row)
End If
Next Hcr
If Adt = 0 Then
MsgBox "AKTARILACAK BİR HÜCRE BULAMADIM....", vbCritical, "Excel.Web.Tr"
Else
MsgBox Adt & " ADET HÜCRE AKTARILMIŞTIR....", vbInformation, "Excel.Web.Tr"
End If
End Sub
Hocam Çok teşekkür ederim, elinize sağlık
Rica ederim.
Benimkisi amatörce bir çözüm. Satır sayısı arttıkça yavaşlama olur.(iç içe döngü nedeniyle)
Ustaca çözüm her zamanki gibi Sayın Yeşertener'den gelmiş. Her olasılığı dikkate alan bu çözümü kullanmanızı öneririm.
Bu kodlardan ben de yararlandım.
Teşekkürler Sayın Yeşertener.