Excell ile birden fazla alt satırı üste taşıma?

[didemeren]

merhaba arkadaşlar

sorunumu resim ile açıklamaya çalıştım tablom aynen olduğu gibidir.

alt satırları üst satırın yanına taşımak istiyorum. 29 bin satır var tek tek zor olacak gibi. yardımcı olur musunuz?

 

[ÖmerFaruk]

Dosyanızın yedeğini alın
Bir module ekleyip çalıştırın

Sub Satırlar()
Dim ilkhücre As Range
Set ilkhücre = Range("B1")

Kol = ilkhücre.Column
ilk = ilkhücre.Row
Son = Cells(Rows.Count, Kol).End(3).Row

For i = Son To ilk + 1 Step -1
    If Cells(i, Kol) <> "" And Cells(i - 1, Kol) <> "" Then
        Cells(i - 1, Kol + 1) = Cells(i, Kol)
        Cells(i, Kol) = ""
        i = i - 1
    End If
Next i
End Sub

 

[Korhan Ayhan]

MErhaba,

Öncelikle profilinizde yazan aşağıdaki ifadeyi kullandığınız ofis sürümüne göre güncellemenizi rica edeceğim.

Excel Vers. ve Dili Excell



Alternatif;

Hız olarak avantaj sağlayabilir.

Verilerinizin C5 hücresinden başladığını varsaydım. Ayrıca aradaki boş satırların olacağını düşünerek sildirmedim. İhtiyaca göre revize edilebilir.

Sonuçları E-F sütunlarına yazar.

Option Explicit

Sub Move_Rows_Up()
    Dim My_Data As Variant, X As Long, Last_Row As Long
    Dim Record_Count As Long, Process_Time As Double
   
    Process_Time = Timer
   
    Last_Row = Cells(Rows.Count, 3).End(3).Row
    If Last_Row < 6 Then Last_Row = 6
   
    My_Data = Range("C5:C" & Last_Row).Value
   
    ReDim My_List(1 To Rows.Count, 1 To 2)
   
    Record_Count = 1
   
    For X = LBound(My_Data, 1) To UBound(My_Data, 1) Step 3
        If My_Data(X, 1) <> "" Then
            My_List(Record_Count, 1) = My_Data(X, 1)
            My_List(Record_Count, 2) = My_Data(X + 1, 1)
            Record_Count = Record_Count + 3
        End If
    Next

    Range("E5").Resize(Record_Count, 2) = My_List
   
    MsgBox "Your transaction is complete." & vbCr & vbCr & _
           "Processing time : " & Format(Timer - Process_Time, "0.00") & " Second"
End Sub