boş satırları yoksayarak kopyalama.

[canard85]

Merhaba üstatlar,

ekdeki excel kitabında "yeşildefter" sekmesindeki sarıya boyadığım verileri "hakediş" sekmesine sırası ve formulleriyle kopyalamak istiyorum. arada boşluklar olduğu için yapamadım. bu konuda yardımınıza ihtiyacım var. Teşekkürler.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Kopyala()
    
    Dim Sy As Worksheet, sat As Long, i As Long
       
    Set Sy = Sheets("yeşil defter")
      
    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
    End With
    Sheets("hakediş").Select
    Range("B7:I20").ClearContents
    
    sat = 7
    For i = 8 To Sy.Cells(Rows.Count, "D").End(xlUp).Row Step 4
        Sy.Cells(i, "B").Resize(1, 3).Copy
        Cells(sat, "B").Select
        ActiveSheet.Paste Link:=True
        
        Sy.Cells(i, "E").Copy
        Cells(sat, "E").Select
        ActiveSheet.Paste Link:=True
        
        Sy.Cells(i, "F").Resize(1, 3).Copy
        Cells(sat, "G").Select
        ActiveSheet.Paste Link:=True
        sat = sat + 1
    Next i
    
    With Application
        .CutCopyMode = False
        .Calculation = xlAutomatic
        .ScreenUpdating = True
    End With
    
End Sub

.