Dolu Değerleri Başka Hücreye Kodla Yazdırmak

[betoncu]

X Sütunundan AL Sütununa ve AP Sütunundan BE Sütununa:

69. satır ile 110. satır arasında yazan dolu hücre değerlerinin sıra ile yukarıdan aşağıya ilgili sütunda 6. satır ile 14. satır arasında yazılmasını hangi kodla sağlarız?


Örnek dosya ektedir. Yardımlarınızı bekliyorum...

 

[betoncu]

Güncel Örnek Dosyası

Arkadaşlar örnek dosyayı güncelledim. Öncekinde şifre vardı. Bu yeni dosya üzerinden yardımlarınızı bekliyorum...

 

[betoncu]

Eğer bu işlemi yapmak uzun ise arkadaşlar sadece bir sütuna ait kodu yazarsanız diğerlerini kendim uyarlamaya çalışacağım.

 

[betoncu]

Arkadaşlar sorumun cevabını aşağıdaki kodları hazırlayarak buldum fakat şöyle bir sıkıntım var. Bu makroyu devreye aldığımda makronun hesap yaparak tamamlanması yaklaşık olarak 5 dakika sürüyor. Bu süreyi kısaltamazmıyız? Daha pratikbir kod yazabilirmiyiz?


Sub DoluAktar()

Dim sat As Long, i As Long

Range("X6:X14").ClearContents 'Bir önceki işlemden veri kalmaması için dolu hücrelerin yazdırılacağı alan temizlenir.

sat = 6 'Dolu hücreleri kaçıncı satırdan yazdırmaya başlatılacaksa o satır numarası yazılır.
For i = 69 To Cells(Rows.Count, "X").End(xlUp).Row 'Dolu ve boş verilerin başladığı sütun ve satır bilgisini ifade eder.
If Cells(i, "X") <> "" Then ' Dolu hücreye ait sütun bilgisini ifade eder.
Cells(sat, "X") = Cells(i, "X") 'Yazdırılacak sütun ve daha sonra dolu ve boş verilerin bulunduğu sütun bilgisini ifade eder.
sat = sat + 1
End If
Next i

Range("Y6:Y14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "Y").End(xlUp).Row
If Cells(i, "Y") <> "" Then
Cells(sat, "Y") = Cells(i, "Y")
sat = sat + 1
End If
Next i

Range("Z6:Z14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "Z").End(xlUp).Row
If Cells(i, "Z") <> "" Then
Cells(sat, "Z") = Cells(i, "Z")
sat = sat + 1
End If
Next i

Range("AA6:AA14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AA").End(xlUp).Row
If Cells(i, "AA") <> "" Then '
Cells(sat, "AA") = Cells(i, "AA")
sat = sat + 1
End If
Next i

Range("AB6:AB14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AB").End(xlUp).Row
If Cells(i, "AB") <> "" Then
Cells(sat, "AB") = Cells(i, "AB")
sat = sat + 1
End If
Next i

Range("AC6:AC14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AC").End(xlUp).Row
If Cells(i, "AC") <> "" Then
Cells(sat, "AC") = Cells(i, "AC")
sat = sat + 1
End If
Next i


Range("AD6:AD14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AD").End(xlUp).Row
If Cells(i, "AD") <> "" Then
Cells(sat, "AD") = Cells(i, "AD")
sat = sat + 1
End If
Next i

Range("AE6:AE14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AE").End(xlUp).Row
If Cells(i, "AE") <> "" Then
Cells(sat, "AE") = Cells(i, "AE")
sat = sat + 1
End If
Next i

Range("AF6:AF14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AF").End(xlUp).Row
If Cells(i, "AF") <> "" Then
Cells(sat, "AF") = Cells(i, "AF")
sat = sat + 1
End If
Next i

Range("AG6:AG14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AG").End(xlUp).Row
If Cells(i, "AG") <> "" Then
Cells(sat, "AG") = Cells(i, "AG")
sat = sat + 1
End If
Next i

Range("AH6:AH14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AH").End(xlUp).Row
If Cells(i, "AH") <> "" Then
Cells(sat, "AH") = Cells(i, "AH")
sat = sat + 1
End If
Next i

Range("AI6:AI14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AI").End(xlUp).Row
If Cells(i, "AI") <> "" Then
Cells(sat, "AI") = Cells(i, "AI")
sat = sat + 1
End If
Next i

Range("AJ6:AJ14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AJ").End(xlUp).Row
If Cells(i, "AJ") <> "" Then
Cells(sat, "AJ") = Cells(i, "AJ")
sat = sat + 1
End If
Next i

Range("AK6:AK14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AK").End(xlUp).Row
If Cells(i, "AK") <> "" Then
Cells(sat, "AK") = Cells(i, "AK")
sat = sat + 1
End If
Next i


Range("AL6:AL14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AL").End(xlUp).Row
If Cells(i, "AL") <> "" Then
Cells(sat, "AL") = Cells(i, "AL")
sat = sat + 1
End If
Next i

Range("AP6:AP14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AP").End(xlUp).Row
If Cells(i, "AP") <> "" Then
Cells(sat, "AP") = Cells(i, "AP")
sat = sat + 1
End If
Next i

Range("AQ6:AQ14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AQ").End(xlUp).Row
If Cells(i, "AQ") <> "" Then
Cells(sat, "AQ") = Cells(i, "AQ")
sat = sat + 1
End If
Next i

Range("AR6:AR14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AR").End(xlUp).Row
If Cells(i, "AR") <> "" Then
Cells(sat, "AR") = Cells(i, "AR")
sat = sat + 1
End If
Next i

Range("AS6:AS14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AS").End(xlUp).Row
If Cells(i, "AS") <> "" Then
Cells(sat, "AS") = Cells(i, "AS")
sat = sat + 1
End If
Next i

Range("AT6:AT14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AT").End(xlUp).Row
If Cells(i, "AT") <> "" Then
Cells(sat, "AT") = Cells(i, "AT")
sat = sat + 1
End If
Next i

Range("AU6:AU14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AU").End(xlUp).Row
If Cells(i, "AU") <> "" Then
Cells(sat, "AU") = Cells(i, "AU")
sat = sat + 1
End If
Next i

Range("AV6:AV14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AV").End(xlUp).Row
If Cells(i, "AV") <> "" Then
Cells(sat, "AV") = Cells(i, "AV")
sat = sat + 1
End If
Next i

Range("AW6:AW14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AW").End(xlUp).Row
If Cells(i, "AW") <> "" Then
Cells(sat, "AW") = Cells(i, "AW")
sat = sat + 1
End If
Next i

Range("AX6:AX14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AX").End(xlUp).Row
If Cells(i, "AX") <> "" Then
Cells(sat, "AX") = Cells(i, "AX")
sat = sat + 1
End If
Next i

Range("AY6:AY14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AY").End(xlUp).Row
If Cells(i, "AY") <> "" Then
Cells(sat, "AY") = Cells(i, "AY")
sat = sat + 1
End If
Next i

Range("AZ6:AZ14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "AZ").End(xlUp).Row
If Cells(i, "AZ") <> "" Then
Cells(sat, "AZ") = Cells(i, "AZ")
sat = sat + 1
End If
Next i

Range("BA6:BA14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "BA").End(xlUp).Row
If Cells(i, "BA") <> "" Then
Cells(sat, "BA") = Cells(i, "BA")
sat = sat + 1
End If
Next i

Range("BB6:BB14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "BB").End(xlUp).Row
If Cells(i, "BB") <> "" Then
Cells(sat, "BB") = Cells(i, "BB")
sat = sat + 1
End If
Next i

Range("BC6:BC14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "BC").End(xlUp).Row
If Cells(i, "BC") <> "" Then
Cells(sat, "BC") = Cells(i, "BC")
sat = sat + 1
End If
Next i

Range("BD6:BD14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "BD").End(xlUp).Row
If Cells(i, "BD") <> "" Then
Cells(sat, "BD") = Cells(i, "BD")
sat = sat + 1
End If
Next i

Range("BE6:BE14").ClearContents

sat = 6
For i = 69 To Cells(Rows.Count, "BE").End(xlUp).Row
If Cells(i, "BE") <> "" Then
Cells(sat, "BE") = Cells(i, "BE")
sat = sat + 1
End If
Next i


End Sub