Soru Bos satirlarin altindaki yazilari yukari tasima

[Nizi]

Merhaba arkadaslar,
Benim calisdigim dosya asagida gosterdigim gibi

Ben bunu makro ile bos satirlarin asagisinda olan yazilari yukari tasimak istiyorum. Tablo 10 sira olarak kalmasi lazim. Asagida gosterdiyim gibi.

Bana yardim ede bilecek biri varmi? Makroda iyi degilim.

 

[Necdet]

Merhaba.

1. B:C sütunlarını siçin
2. F5
3. Özel
4. Boşluklar
5. Tamam
6. Sağ tık
7. sil
8. Hücreleri Yukarı Sürükle
9. Tamam

Yukarıda anlattıklarımın makro kaydet ile alıp düzenlediğim kodlar :

Sub Makro1()
    
    On Error Resume Next
    Columns("B:C").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    
End Sub

 

[Nizi]

Merhaba.

1. B:C sütunlarını siçin
2. F5
3. Özel
4. Boşluklar
5. Tamam
6. Sağ tık
7. sil
8. Hücreleri Yukarı Sürükle
9. Tamam

Yukarıda anlattıklarımın makro kaydet ile alıp düzenlediğim kodlar :

Sub Makro1()
    
    On Error Resume Next
    Columns("B:C").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    
End Sub

ilginiz icin cok tesekkur ederim amma ben hucreleri yukari surukle kismini tam anlamadim. Makronu denedigimde yazilari 1ci sutune kaldiriyor. ben bunun mesela 10cu sutunda kalmasini istiyorum. 10 ve 29 cu sutunlar arasinda degisiklik yapa biliyorum, yukarida ve asagida baska yazilar var. Asagida resim olarak tam calisdigim dosyani gonderiyorum.

 

[Necdet]

Örnek dosyanızı paylaşım sitelerinden birine yükleyin.
Doğrudan sütunları seçerseniz ve birinci, ikinci vs satırlar boş ise kaydırır.
Verinin bulunduğu alanı seçmeniz gerek.

 

[Nizi]

Örnek dosyanızı paylaşım sitelerinden birine yükleyin.
Doğrudan sütunları seçerseniz ve birinci, ikinci vs satırlar boş ise kaydırır.
Verinin bulunduğu alanı seçmeniz gerek.

Dosya asagidaki linkde. sheet1-dekini sheet2-deki gibi olmasini istiyorum

test.xlsm

Посмотреть и скачать с Яндекс.Диска

disk.yandex.ru

 

[veyselemre]

Sub test()
    Dim i%, ii%
    With Sheets("sheet1")
        For i = 10 To 28
            If .Cells(i, 3).Value = "" Then
                For ii = i + 1 To 29
                    If .Cells(ii, 3).Value <> "" Then
                        .Cells(i, 3).Resize(, 12).Value = .Cells(ii, 3).Resize(, 12).Value
                        .Cells(ii, 3).Resize(, 12).ClearContents
                        Exit For
                    End If
                Next ii
            End If
        Next i
    End With
End Sub

 

[Nizi]

Sub test()
    Dim i%, ii%
    With Sheets("sheet1")
        For i = 10 To 28
            If .Cells(i, 3).Value = "" Then
                For ii = i + 1 To 29
                    If .Cells(ii, 3).Value <> "" Then
                        .Cells(i, 3).Resize(, 12).Value = .Cells(ii, 3).Resize(, 12).Value
                        .Cells(ii, 3).Resize(, 12).ClearContents
                        Exit For
                    End If
                Next ii
            End If
        Next i
    End With
End Sub

Cok tesekkur ederim hocam. Harika

 

[Necdet]

Merhaba,
Aşağıdaki kodları deneyiniz.

Sub Makro1()

    ActiveWorkbook.Worksheets("sheet1").ListObjects("Table244567823").Sort. _
        SortFields.Add2 Key:=Range("Table244567823[PT Nr.]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("sheet1").ListObjects("Table244567823").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

 

[Nizi]

Merhaba,
Aşağıdaki kodları deneyiniz.

Sub Makro1()

    ActiveWorkbook.Worksheets("sheet1").ListObjects("Table244567823").Sort. _
        SortFields.Add2 Key:=Range("Table244567823[PT Nr.]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("sheet1").ListObjects("Table244567823").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

Emre bey yukarida makrosunu gonderdi. Yaptim cok iyi sonuc verdi. Sizede tesekur ediyorum ilgilendiyiniz icin.

 

[Nizi]

Sub test()
    Dim i%, ii%
    With Sheets("sheet1")
        For i = 10 To 28
            If .Cells(i, 3).Value = "" Then
                For ii = i + 1 To 29
                    If .Cells(ii, 3).Value <> "" Then
                        .Cells(i, 3).Resize(, 12).Value = .Cells(ii, 3).Resize(, 12).Value
                        .Cells(ii, 3).Resize(, 12).ClearContents
                        Exit For
                    End If
                Next ii
            End If
        Next i
    End With
End Sub

Merhaba. Bu makronu kullaniyorum cok iyi. Sadece bir yerde takildim. Sheet2 diye kopya cikardigimda bu makro calismiyor. With Sheets("sheet1") kullanmadan bu kodu nasil kullana bilirim?