Hücre Değerine Göre Kopyalama..Yardım..

[iseyhan1299]

Merhaba arkadaşlar...

J Sütunundaki değer İŞLETME ise o satırdaki değerleri işletme sayfasına ,MAL ALIM ise mal alım sayfasına yazdırmak istiyorum ...Yardım ederseniz Sevinirim...

 

[asi_kral]

Merhaba
Kitabınızın kod bölümünde bulunan Thisworkbook sayfasına bu kodu kopyalayın ve deneyin.

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim S1 As Worksheet, STR As Long, ÇLŞ As Variant
If ActiveSheet.Name <> "Sayfa1" Then
Application.ScreenUpdating = False
Cells.ClearContents
ÇLŞ = ActiveCell.Address
Set S1 = Sheets("Sayfa1")
STR = S1.Range("A" & Rows.Count).End(xlUp).Row
With WorksheetFunction
S1.Range("A2:J" & STR).AutoFilter 10, ActiveSheet.Name
If .Subtotal(3, S1.Range("A3:A" & STR)) > 0 Then
S1.Range("A3:J" & STR).Copy
Range("A1").PasteSpecial (xlPasteValues)
End If
S1.Range("A3:J" & STR).AutoFilter
Range(ÇLŞ).Select
End With: End If
Application.ScreenUpdating = True
End Sub

Not : 2. Satır'a başlıkları yazınız.

 

[iseyhan1299]

Tam istediğim gibi bir kod fakat kendi kullandığım forma uyduramadım ekte gönderdiğim form üzerine uygularsanız minnettar olurum....

 

[asi_kral]

Kodu bununla değiştirin.

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim S1 As Worksheet, STR As Long, ÇLŞ As Variant
If ActiveSheet.Name <> "FATURA 1004" Then
Application.ScreenUpdating = False
Range("A5:K" & Rows.Count).ClearContents
ÇLŞ = ActiveCell.Address
Set S1 = Sheets("FATURA 1004")
STR = S1.Range("A" & Rows.Count).End(xlUp).Row
With WorksheetFunction
S1.Range("A4:K" & STR).AutoFilter 11, ActiveSheet.Name
If .Subtotal(3, S1.Range("A5:A" & STR)) > 0 Then
S1.Range("A5:K" & STR).Copy
Range("A5").PasteSpecial (xlPasteValues)
End If
S1.Range("A3:K" & STR).AutoFilter
Range(ÇLŞ).Select
End With: End If
Application.ScreenUpdating = True
End Sub

 

[iseyhan1299]

Çok teşekkür ederim ilaç gibi geldi...Eğer çok olmazsa birşey daha rica edicem...
İŞLETME ve MAL ALIM sayfalarında sadece o aya ait faturaların görünmesini istiyorum.Sayfaların yukarısında cari ayın dönemini yazdığımda sdece o döneme ait verilerin olmasını istiyorum...

Saygılar...

 

[asi_kral]

1 - Dosyanızda 3 farklı tarih bölümü var hangisi baz alınacak
2- Taksit taksit sormayın sorunuzu şimdi kodu değiştirmek zorunda kalacağız. Boş yere mi yazdık kodu.

 

[iseyhan1299]

isletme ve mal alim sayfasindaki bilgilerin sadece yukarida girdigim tarih araliginda olanlarin listelenmesini istiyorum. ilk sutunda yer alan fatura tarihine gore . Yanliz arada fircayida attin ya hocam ))

 

[asi_kral]

isletme ve mal alim sayfasindaki bilgilerin sadece yukarida girdigim tarih araliginda olanlarin listelenmesini istiyorum. ilk sutunda yer alan fatura tarihine gore . Yanliz arada fircayida attin ya hocam ))

Bu kodu deneyin.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim S1 As Worksheet, STR As Long, ÇLŞ As Variant
If ActiveSheet.Name <> "FATURA 1004" Then
Application.ScreenUpdating = False
Range("A5:K" & Rows.Count).ClearContents
ÇLŞ = ActiveCell.Address
Set S1 = Sheets("FATURA 1004")
STR = S1.Range("A" & Rows.Count).End(xlUp).Row
With WorksheetFunction
S1.Range("A4:K" & STR).AutoFilter 1, ">=" & CDbl(Range("G2")), _
xlAnd, "<=" & CDbl(Range("G3"))
S1.Range("A4:K" & STR).AutoFilter 11, ActiveSheet.Name
If .Subtotal(3, S1.Range("A5:A" & STR)) > 0 Then
S1.Range("A5:K" & STR).Copy
Range("A5").PasteSpecial (xlPasteValues)
End If
S1.Range("A3:K" & STR).AutoFilter
Range(ÇLŞ).Select
End With: End If
Application.ScreenUpdating = True
End Sub

 

[iseyhan1299]

Hocam allah razı olsun....Kod yazan elleriniz dert görmesin....