Girilen veriye göre kendi başka sayfaya aktarma.

[eserpil]

Acil: Girilen veriye göre başka sayfaya aktarma

sayfa 1 de girilen verileri kayıtlı oldukları yerlere gönderme
yardımlarınız için şimdiden teşekkür ederim

 

[Ömer]

Merhaba,

Kodları module kopyalayarak çalıştırın.

Option Explicit
 
Sub SayfaAktar()
Dim i, j As Long, Sayfa As String, S1 As Worksheet
Set S1 = Sheets("GİDER")
Application.ScreenUpdating = False
For j = 2 To Worksheets.Count
    Sheets(j).Cells.Delete Shift:=xlUp
Next j
For i = 2 To S1.[A65536].End(3).Row
    Sayfa = Cells(i, "A")
        If Not SayfaVarMi(Sayfa) Then
            Sheets.Add After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = Sayfa
            S1.Select
            S1.Range("A1:D1").Copy Sheets(Sayfa).Range("A1")
        End If
    S1.Range("A1:D1").Copy Sheets(Sayfa).Range("A1")
    S1.Range("A" & i & ":D" & i).Copy Sheets(Sayfa).Range("A" & _
    Sheets(Sayfa).[A65536].End(3).Row + 1)
    Sheets(Sayfa).Range("A:D").EntireColumn.AutoFit
Next i
Set S1 = Nothing
Application.ScreenUpdating = True
End Sub
 
Function SayfaVarMi(SayfaAdi As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function

.

 

[eserpil]

YAPTIM ama çalışmadı

 

[Ömer]

Sayfa üzerindeki Düzenle butonuna basarak deneyin.

.

 

[mustafaine1]

ben de denedim mukemmel calisiyor..

 

[eserpil]

birde bunu formülle yapamazmıyız

 

[eserpil]

çok teşekkür ederim ellerineze saglık yannız başınızı agrıtmassam birde bunu formülle yapamazmıyız

 

[Ömer]

Eki inceleyin.

.