- Katılım
- 17 Ekim 2008
- Mesajlar
- 33
- Excel Vers. ve Dili
- 2007 tr
ekteki dosyada gelir ve gider sayfalarındaki bazı hücreleri kasa sayfasına kopyalamak istiyorum nasıl yapabilirim??
Ekli dosyalar
-
286.5 KB Görüntüleme: 22
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
sayfa kodlarını üstekilerle değiştirinPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 <> Empty Then
For Each fCell In Selection
cvp = MsgBox("SATIRI KAYDETMEK İSTİYORMUSUNUZ ?", vbYesNo, " FEDEAL ")
If cvp = vbNo Then
Else
For i = 1 To 7
ActiveCell.Offset(0, i).Interior.ColorIndex = 6
Next
fed = Sheets("kasa").Range("b65536").End(xlUp).Row + 1
Sheets("kasa").Range("b" & fed).Value = ActiveCell.Offset(0, 1).Value
Sheets("kasa").Range("d" & fed).Value = ActiveCell.Offset(0, 2).Value
If ActiveCell.Offset(0, 7).Value = "ödendi" Or ActiveCell.Offset(0, 7).Value = "ÖDENDİ" Or ActiveCell.Offset(0, 7).Value = "Ödendi" Then
Sheets("kasa").Range("g" & fed).Value = ActiveCell.Offset(0, 6).Value
Else
Sheets("kasa").Range("h" & fed).Value = ActiveCell.Offset(0, 6).Value
End If
End If
Next fCell
End If
End Sub
ohalde gelir sayfasındaki kırmızı kodları 9 yapınaklımda tutarım onu son teşekkirler ancak bi sorun daha var oda gelir sayfasından tutar sütununukopyalıyor tutarı değil kazancı kopyalacaktı bide bunu sormadan otomatik yazılır yazılmaz atacak şekilde değiştirebilir miyiz?
iyi çalışmalar.Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 <> Empty Then
For Each fcell In Selection
cvp = MsgBox("SATIRI KAYDETMEK İSTİYORMUSUNUZ ?", vbYesNo, " FEDEAL ")
If cvp = vbNo Then
Else
For i = 1 To 11
ActiveCell.Offset(0, i).Interior.ColorIndex = 6
Next
fed = Sheets("kasa").Range("b65536").End(xlUp).Row + 1
Sheets("kasa").Range("b" & fed).Value = ActiveCell.Offset(0, 1).Value
Sheets("kasa").Range("c" & fed).Value = ActiveCell.Offset(0, 2).Value
If ActiveCell.Offset(0, 11).Value = "alındı" Or ActiveCell.Offset(0, 11).Value = "ALINDI" Or ActiveCell.Offset(0, 11).Value = "Alındı" Then
Sheets("kasa").Range("e" & fed).Value = ActiveCell.Offset(0, 8).Value
Else
Sheets("kasa").Range("f" & fed).Value = ActiveCell.Offset(0, 8).Value
End If
End If
Next fcell
End If
End Sub
sorgu çıkmasını istemezseniz kırmızı kodları silin (buarada uygulamak açıklamaktan kolay ama amaç balık tutmayı öğretmek),saygılar.Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 <> Empty Then
For Each fcell In Selection
cvp = MsgBox("SATIRI KAYDETMEK İSTİYORMUSUNUZ ?", vbYesNo, " FEDEAL ")
If cvp = vbNo Then
Else
For i = 1 To 11
ActiveCell.Offset(0, i).Interior.ColorIndex = 6
Next
fed = Sheets("kasa").Range("b65536").End(xlUp).Row + 1
Sheets("kasa").Range("b" & fed).Value = ActiveCell.Offset(0, 1).Value
Sheets("kasa").Range("c" & fed).Value = ActiveCell.Offset(0, 2).Value
If ActiveCell.Offset(0, 11).Value = "alındı" Or ActiveCell.Offset(0, 11).Value = "ALINDI" Or ActiveCell.Offset(0, 11).Value = "Alındı" Then
Sheets("kasa").Range("e" & fed).Value = ActiveCell.Offset(0, 8).Value
Else
Sheets("kasa").Range("f" & fed).Value = ActiveCell.Offset(0, 8).Value
End If
End If
Next fcell
End If
End Sub