açılan sayfaya veri girişinde silme me

[eserpil]

sagolsun arakadaşlar yardımcı oldular kod için ama bu butona basıldında açılan sayfalara veri girişi yapamıyorum teklar butona bastıgımda siliniyor

 

[Ömer]

Kodları aşağıdakilerle değiştirin.

Option Explicit
 
Sub SayfaAktar()
Dim i As Long, Sayfa As String, S1 As Worksheet
Set S1 = Sheets("GİDER")
Application.ScreenUpdating = False
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]

yazıyor ama busefer gider sayfasını iki kere kopyalıyor

 

[Ömer]

Silmesini istemiyorsanız iki kere yazması normaldir.

Soru açıklamalarında detaya inmeye özen gösterin.

• Gider sayfasında olan veriler sayfalara aktarıldıktan sonra gider sayfasındaki veriler silinse olur mu? ( Nasıl olsa sayfalara aktarıldı mantığı ile )

• Gider sayfasından aktarılan bir değer ilgili sayfada var ise tekrar aktarılmazsa olur mu? ( Bu olmaz sanırım, çalışma mantığınızı bilmediğim için sadece öneri. )

Cevabınıza göre düzenlemekte fayda var.

.

 

[eserpil]

açıklayıcı olmadıgım için pardon mesala gider sayfasına yazdıgım verileri türe göre aktarmasını istiyorum örnek gıdalar gıdalarsayfasına giyimler giyim sayfasına birnevi hepsine cari kart açmak gibi ama ben açılan sayfayada veri girmek istiyorum örnek gııda sayfasına kopyalanan veriye açıklama ekleme

 

[eserpil]

inşaallah açıklayıcı olmuşumdur

 

[Ömer]

açıklayıcı olmadıgım için pardon mesala gider sayfasına yazdıgım verileri türe göre aktarmasını istiyorum örnek gıdalar gıdalarsayfasına giyimler giyim sayfasına birnevi hepsine cari kart açmak gibi ama ben açılan sayfayada veri girmek istiyorum örnek gııda sayfasına kopyalanan veriye açıklama ekleme

#4 nolu mesajdaki soruları cevaplandırsanız sevirim.

.

 

[eserpil]

Gider sayfasında olan veriler sayfalara aktarıldıktan sonra gider sayfasındaki veriler silinse olur mu? ( Nasıl olsa sayfalara aktarıldı mantığı ile ) hayır bu olmaz
Gider sayfasından aktarılan bir değer ilgili sayfada var ise tekrar aktarılmazsa olur mu? evet bu olur

 

[eserpil]

Gider sayfasında olan veriler sayfalara aktarıldıktan sonra gider sayfasındaki veriler silinse olur mu? ( Nasıl olsa sayfalara aktarıldı mantığı ile ) HAYIR
Gider sayfasından aktarılan bir değer ilgili sayfada var ise tekrar aktarılmazsa olur mu? EVEET

EKLİ DOSYAYADA AÇIKLAMA EKLEDİM

 

[Ömer]

Bu şekilde deneyin.

Option Explicit
 
Sub SayfaAktar()
On Error Resume Next
Dim i, j, k, sson As Long, Sayfa As String, S1 As Worksheet
Set S1 = Sheets("GİDER")
Application.ScreenUpdating = False
For i = 2 To S1.[A65536].End(3).Row
    Sayfa = Trim(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
For j = 2 To Worksheets.Count
    sson = Sheets(j).[A65536].End(3).Row
    Sheets(j).Range("A1:D" & sson).AdvancedFilter _
    Action:=xlFilterInPlace, Unique:=True
    For k = sson To 2 Step -1
        If Sheets(j).Rows(k).Hidden Then Sheets(j).Rows(k).Delete
    Next k
Next j
ActiveSheet.ShowAllData
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]

çok teşekür ederim hocam borcumu nasıl ödicem