Veri Düzenleme

[yes107yes107yes107]

ekte sunduğum dosyada bir satırda bulunan verinin en son stündaki alanı kopyalama yöntemini otomatik nasıl yaparım şimdiden teşekkür ederim

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
Application.ScreenUpdating = False

sat = 8
son = [a65536].End(3).Row

For i = 2 To son

Cells(sat, "A") = Cells(i, "A")
Cells(sat, "b") = Cells(i, "b")
Cells(sat, "c") = Cells(i, "c")
Cells(sat, "d") = Cells(i, "d")
Range("A" & sat & ":D" & sat).Interior.Color = vbYellow
sat = sat + 1

Cells(sat, "A") = Cells(i, "A")
Cells(sat, "b") = Cells(i, "b")
Cells(sat, "c") = Cells(i, "c")
Cells(sat, "d") = Cells(i, "e")
Range("A" & sat & ":D" & sat).Interior.Color = vbRed
sat = sat + 1

Next i
Application.ScreenUpdating = True
MsgBox " B İ T T İ "
End Sub

. . .

 

[Necdet]

Merhaba,

Konu başlığını sorunuzu özetleyecek şekilde değiştiriniz.

 

[yes107yes107yes107]

elinize sağlık bunu 2 inci sayfada yapabilirmiyiz verilewrin üstüne yazıyor

 

[Necdet]

Merhaba,

Konu başlığını sorunuzu özetleyecek şekilde değiştiriniz.

Herhangi bir çaba yok. Kime diyoruz ki?

Sub Duzenle()
    
    Dim i   As Long
    Dim j   As Long
    
    Application.ScreenUpdating = False
    
    For i = Cells(Rows.Count, "A").End(3).Row To 2 Step -1
        j = i + 1
        Rows(j).Insert
        Cells(j, "A") = Cells(i, "A")
        Cells(j, "B") = Cells(i, "B")
        Cells(j, "C") = Cells(i, "C")
        Cells(j, "D") = Cells(i, "E")
    Next i
    
    Range("E:E").ClearContents
    
    Application.ScreenUpdating = True
    MsgBox "İŞEM TAMAMLANMIŞTIR....", vbInformation, "Excel.web.tr"
    
End Sub

 

[yes107yes107yes107]

hocam olmadı bir eksiklik var heralde

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
Application.ScreenUpdating = False

Dim S1 As Worksheet
Dim S2 As Worksheet
Set S1 = Sheets("SAYFA1")
Set S2 = Sheets("SAYFA2")

S2.Columns("A:D").Delete
sat = 1
son = S1.[a65536].End(3).Row

For i = 2 To son
S2.Cells(sat, "A") = S1.Cells(i, "A")
S2.Cells(sat, "b") = S1.Cells(i, "b")
S2.Cells(sat, "c") = S1.Cells(i, "c")
S2.Cells(sat, "d") = S1.Cells(i, "d")
S2.Range("A" & sat & ":D" & sat).Interior.Color = vbYellow
sat = sat + 1

S2.Cells(sat, "A") = S1.Cells(i, "A")
S2.Cells(sat, "b") = S1.Cells(i, "b")
S2.Cells(sat, "c") = S1.Cells(i, "c")
S2.Cells(sat, "d") = S1.Cells(i, "e")
S2.Range("A" & sat & ":D" & sat).Interior.Color = vbRed
sat = sat + 1
Next i

Set S1 = Nothing
Set S2 = Nothing
Application.ScreenUpdating = True
MsgBox " B İ T T İ "
End Sub

. . .

 

[Necdet]

hocam olmadı bir eksiklik var heralde

Konu başlığı mı olmadı?

 

[Necdet]

hocam olmadı bir eksiklik var heralde

Ne gibi bir eksik?

 

[yes107yes107yes107]

ALLAH razı olsun hocam

 

[yes107yes107yes107]

hocam aynı tabloya benzer bir veri düzenlemem gerekiyor bir sayfa içinde anlattım ilk tabloda sondaki verileri bir alta getirmem lazım

 

[Necdet]

Merhaba,

Kodları deneyiniz.

Sub Duzenle()
    
    Dim i   As Long, _
        j   As Long, _
        Sh1 As Worksheet, _
        Sh2 As Worksheet
    
    Application.ScreenUpdating = False
    
    Set Sh1 = Sheets("Sheet1")
    Set Sh2 = Sheets("Sheet2")
    
    Sh2.Cells.Clear
    
    Sh1.Range("A2:j2").Copy Sh2.Range("A1")
    j = 1
    
    For i = 3 To Sh1.Cells(Rows.Count, "A").End(3).Row
        j = j + 1
        Sh1.Range("A" & i & ":j" & i).Copy Sh2.Range("A" & j)
        j = j + 1
        Sh1.Range("A" & i & ":j" & i).Copy Sh2.Range("A" & j)
        Sh1.Range("N" & i).Copy Sh2.Range("H" & j)
        Sh1.Range("O" & i).Copy Sh2.Range("J" & j)
    Next i
    
    Application.ScreenUpdating = True
    
    Sh2.Select
    MsgBox "Düzenleme Bitmiştir....", vbInformation, "excel.web.tr"
    
End Sub