hesap pusulası - verilerin olduğu sayfadan bilgileri başka sheet kaydetmek.

[latimera]

üstadlar slms,

ana sayfada girilen verilen başka sheet nasıl kayıt ettirebilirim.

 

[Ömer]

Merhaba,

Module kopyalarak çalıştırınız.

Sub Aktar()
 
    Dim Sg As Worksheet, bul As Range
 
    Set Sg = Sheets("günlük gelir")
    
    Application.ScreenUpdating = False
    Sheets("Toplam").Select
    
    Set bul = Rows(1).Find(Sg.Range("A2"), LookIn:=xlFormulas, LookAt:=xlWhole)
    If Not bul Is Nothing Then
        Sg.Range("C2:C17").Copy
        Cells(2, bul.Column).PasteSpecial xlPasteValues, xlNone
        Application.CutCopyMode = False
        Range("A1").Select
    Else
        MsgBox "Tarihi Bulamadım"
    End If
    
    Application.ScreenUpdating = True
    
End Sub

.

 

[latimera]

aşağıdaki module kesa yapıştır yapılması için neyin düzeltilmesi lazım...

Sub Aktar()

Dim Sg As Worksheet, bul As Range

Set Sg = Sheets("günlük gelir")

Application.ScreenUpdating = False
Sheets("Toplam").Select

Set bul = Rows(1).Find(Sg.Range("A2"), LookIn:=xlFormulas, LookAt:=xlWhole)
If Not bul Is Nothing Then
Sg.Range("C2:C17").Copy
Cells(2, bul.Column).PasteSpecial xlPasteValues, xlNone
Application.CutCopyMode = False
Range("A1").Select
Else
MsgBox "Tarihi Bulamadım"
End If

Application.ScreenUpdating = True

End Sub

 

[latimera]

Aşağıdaki modul de copy yerine kes yapıştır nasıl yapılır ?

Aşağıdaki modul de copy yerine kes yapıştır nasıl yapılır ?

Merhaba,

Module kopyalarak çalıştırınız.

Sub Aktar()
 
    Dim Sg As Worksheet, bul As Range
 
    Set Sg = Sheets("günlük gelir")
    
    Application.ScreenUpdating = False
    Sheets("Toplam").Select
    
    Set bul = Rows(1).Find(Sg.Range("A2"), LookIn:=xlFormulas, LookAt:=xlWhole)
    If Not bul Is Nothing Then
        Sg.Range("C2:C17").Copy
        Cells(2, bul.Column).PasteSpecial xlPasteValues, xlNone
        Application.CutCopyMode = False
        Range("A1").Select
    Else
        MsgBox "Tarihi Bulamadım"
    End If
    
    Application.ScreenUpdating = True
    
End Sub

.

 

[Ömer]

Kesme sebebiniz aktarma sonrası verilerin silinmesi ile ilgili sanırım.

Application.ScreenUpdating = True
satırından önce

Sg.Range("C2:C17").ClearContents

ekleyiniz.

.

 

[latimera]

Ömer bey , bilgi için teşekkür ederim.

Fakat şöyle bir sorun oluştu. Çıkış ve toplam larda kullandığım formuller gidiyor.

onun için ne yapabiliriz.

 

[Ömer]

Sg.Range("C2:C17").ClearContents

aralığı ona göre düzenleyin.

C2:C17 aralığı taşınan ve silinen aralıktır. Siz hangi aralığı istiyorsanız ona göre düzenlersiniz.

.

 

[latimera]

Yarımlar için teşekkür ediyorum.