- Katılım
- 15 Temmuz 2012
- Mesajlar
- 2,802
- Excel Vers. ve Dili
- Ofis 2021 TR 64 Bit
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub aktar59()
Dim j As Byte, i As Long, sat As Long, sh As Worksheet
Set sh = Sheets("Sayfa2")
sh.Range("A:A").ClearContents
sat = 1
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
For j = 1 To 9
For i = 1 To Cells(Rows.Count, j).End(xlUp).Row
sh.Cells(sat, "A").Value = Cells(i, j).Value
sat = sat + 1
Next
Next
Application.ScreenUpdating = True
sh.Select
Set sh = Nothing
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub
Sayın Evren Bey, hayırlı iftarlar.
Göndermiş olduğunuz kod gayet güzel çalışıyor, ellerinize sağlık, bazen veriler BZ sütununa kadar ulaşıyor, bu durumda kodda nerede bir değişiklik yapmam gerekir.
Sub aktar59()
Dim j As Integer, i As Long, sat As Long, sh As Worksheet
Dim sat2 As Integer
Set sh = Sheets("Sayfa2")
sh.Range("A:A").ClearContents
sat = 1
sat2 = 1
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
For j = 1 To Cells(sat2, Columns.Count).End(xlToLeft).Column
For i = 1 To Cells(Rows.Count, j).End(xlUp).Row
sh.Cells(sat, "A").Value = Cells(i, j).Value
sat = sat + 1
Next
sat2 = sat2 + 1
Next
Application.ScreenUpdating = True
sh.Select
Set sh = Nothing
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub
Sayın Evren Bey, ellerinize sağlık çok teşekkür ediyorum, tam istediğim gibi çalışıyor.
Hayırlı ramazanlar.