kopyalama

[dost-el]

sayfa 1 deki yok yazılanları sayfa 2 ye alt alta sıralı kopyalama

 

[Emir Hüseyin Çoban]

. . .

Sub kod()
    Application.ScreenUpdating = False
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Set S1 = Sheets(" Yoklama")
    Set S2 = Sheets("Yok Listesi")
    sat = 2
    
    sec = Selection.Address(0, 0)
    S2.Range("A2:D65536").ClearContents
    
    For i = 5 To 20 Step 5
        For a = 3 To S1.Cells(Rows.Count, 1).End(3).Row
            If S1.Cells(a, i) = "Yok" Then
                S2.Cells(sat, "A") = CDate(S1.Range("Y3") & "." & S1.Range("Z3") & ".2014")
                
                S1.Cells(a, i - 3).Select
                S2.Cells(sat, "B") = S1.Cells(Selection.Row, i - 3)
                S2.Cells(sat, "C") = S1.Cells(a, i - 2)
                S2.Cells(sat, "D") = S1.Cells(a, i - 1)
                sat = sat + 1
            End If
        Next a
    Next i
    
    S1.Range(sec).Select
    Application.ScreenUpdating = True
    
    If S1.Range("Y7") = sat - 2 Then
        MsgBox " B i t t i "
    Else
        MsgBox " H a t a ", vbCritical
    End If
    
End Sub

. . .

 

[acar6783]

Üzerinde çalışıyordum

Yalnız mahalle adı bu şekilde hepsinde çıkmıyor gibi

 

[dost-el]

Hocam Formül İstenildiği Gibi Tek Eksikliği kopyalama hep aynı yere yapıyor her seferinde bir alta kopyalaması gerekmekte

 

[Emir Hüseyin Çoban]

Yeni konu açmanıza gerek yok! Diğer konuyu iptal edin.

S2.Range("A265536").ClearContents Satırını silin ve

sat=2 satırını
Sat= s2.cells(rows.count,1).end(3).row+1 olarak değiştirin.

.

 

[Emir Hüseyin Çoban]

Kodların revize edilmiş hâli.

Sub kod()
    Application.ScreenUpdating = False
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Set S1 = Sheets(" Yoklama")
    Set S2 = Sheets("Yok Listesi")
    [COLOR="Green"]'sat = 2[/COLOR]
     Sat= s2.cells(rows.count,1).end(3).row+1
    
    sec = Selection.Address(0, 0)
   [COLOR="DarkGreen"]' S2.Range("A2:D65536").ClearContents[/COLOR]
    
    For i = 5 To 20 Step 5
        For a = 3 To S1.Cells(Rows.Count, 1).End(3).Row
            If S1.Cells(a, i) = "Yok" Then
                S2.Cells(sat, "A") = CDate(S1.Range("Y3") & "." & S1.Range("Z3") & ".2014")
                
                S1.Cells(a, i - 3).Select
                S2.Cells(sat, "B") = S1.Cells(Selection.Row, i - 3)
                S2.Cells(sat, "C") = S1.Cells(a, i - 2)
                S2.Cells(sat, "D") = S1.Cells(a, i - 1)
                sat = sat + 1
            End If
        Next a
    Next i
    
    S1.Range(sec).Select
    Application.ScreenUpdating = True
    
    [COLOR="green"]'If S1.Range("Y7") = sat - 2 Then[/COLOR]
        MsgBox " B i t t i "
  [COLOR="Green"] 'Else
    '    MsgBox " H a t a ", vbCritical
    'End If[/COLOR]
    
End Sub

.

 

[dost-el]

Hocam Teşekkür Ederim Formül Tamam Başarılar Dilerim

 

[Emir Hüseyin Çoban]

Hocam Teşekkür Ederim Formül Tamam Başarılar Dilerim

.

Merhaba,
İlerleyen zamanlardaki çalışmalarınızda hata olmaması için şu kısma açıklık getireyim.
Yukarıdaki çözümümüz makrodur. Vba penceresinden (alt+f11) girilen prodürlerin ismi makrodur.

Excel sayfası üzerinde formül çubuğundan veya = ile başlayarak girilen prosedürler formül~fonksiyondur.

.