Soru Bos satirlarin altindaki yazilari yukari tasima

Katılım
9 Mayıs 2021
Mesajlar
31
Excel Vers. ve Dili
2021 ENG
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

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,180
Excel Vers. ve Dili
Ofis 365 Türkçe
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 :

Kod:
Sub Makro1()
    
    On Error Resume Next
    Columns("B:C").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    
End Sub
 
Katılım
9 Mayıs 2021
Mesajlar
31
Excel Vers. ve Dili
2021 ENG
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 :

Kod:
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

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,180
Excel Vers. ve Dili
Ofis 365 Türkçe
Ö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.
 
Katılım
9 Mayıs 2021
Mesajlar
31
Excel Vers. ve Dili
2021 ENG
Ö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
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,553
Excel Vers. ve Dili
Pro Plus 2021
Kod:
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
 
Katılım
9 Mayıs 2021
Mesajlar
31
Excel Vers. ve Dili
2021 ENG
Kod:
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

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,180
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,
Aşağıdaki kodları deneyiniz.
Kod:
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
 
Katılım
9 Mayıs 2021
Mesajlar
31
Excel Vers. ve Dili
2021 ENG
Merhaba,
Aşağıdaki kodları deneyiniz.
Kod:
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.
 
Katılım
9 Mayıs 2021
Mesajlar
31
Excel Vers. ve Dili
2021 ENG
Kod:
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?
 
Üst