makroyu alt satırlarda çalıştırma

[fmehmets]

Herkese selamlar,
Alttaki kod, ilk satırın ilk beş hücresindeki değerleri aralarındaki boş hücreleri atlayarak altıncı hücreden itibaren sağa yazıyor; kod bir satır için işimi görüyor fakat alt alta binlerce satırım var,çok uğraştım ama kodu aşağıdaki satırlar için kopyalamanın bir yolunu bulamadım. Bana yardımcı olabilir misiniz?Teşekkürler.

Sub makro()
Dim alan As Range
Set alan = Range("a1:e1")
y = 6
For Each x In alan
If x <> "" Then
Cells(1, y) = x
y = y + 1
End If
Next x


End Sub

 

[ismailem]

Sub makro()
Dim alan, x As Range
Dim s, i, y, ssatir As Long
y = 6
s = 1
ssatir = ActiveSheet.UsedRange.Rows.Count
For i = 1 To ssatir
Set alan = Range("a" & i & ":e" & i)
For Each x In alan
If x <> "" Then
Cells(i, y) = x
y = y + 1
End If
Next x
y = 6
Set x = Nothing
Set alan = Nothing
Next i
End Sub
'Bu makro işinizi görür

 

[Tevfik_Kursun]

Merhaba,
Alternatif olsun

Sub makro()
    Dim alan As Range
    son = Cells(Rows.Count, 5).End(3).Row
            For i = 1 To son
            Set alan = Range("a" & i & ":e" & i)
            y = 6
                For Each x In alan
                    If x <> "" Then
                        Cells(i, y) = x
                        y = y + 1
                    End If
                Next x
                Set x = Nothing
                Set alan = Nothing
            Next i
End Sub

İyi çalışmalar

 

[fmehmets]

Merhaba,
Alternatif olsun

Sub makro()
    Dim alan As Range
    son = Cells(Rows.Count, 5).End(3).Row
            For i = 1 To son
            Set alan = Range("a" & i & ":e" & i)
            y = 6
                For Each x In alan
                    If x <> "" Then
                        Cells(i, y) = x
                        y = y + 1
                    End If
                Next x
                Set x = Nothing
                Set alan = Nothing
            Next i
End Sub

İyi çalışmalar

Çok teşekkür ederim .

 

[fmehmets]

Sub makro()
Dim alan, x As Range
Dim s, i, y, ssatir As Long
y = 6
s = 1
ssatir = ActiveSheet.UsedRange.Rows.Count
For i = 1 To ssatir
Set alan = Range("a" & i & ":e" & i)
For Each x In alan
If x <> "" Then
Cells(i, y) = x
y = y + 1
End If
Next x
y = 6
Set x = Nothing
Set alan = Nothing
Next i
End Sub
'Bu makro işinizi görür

Çok teşekkür ederim.