Aktarım işlemi

[sirkülasyon]

Değerli Abilerim;
Eklediğim formda iki tane sayfam var.
Sayfa1' i veri tabanı gibi düşündüm. Sayfa2' yi çıktı olacak sayfa.
1 - Sayfa1 'e girilen veriler arasında "B Sütununda" aynı kurum adı var ise ve aynı kuruma ait "C Sütununda" alt kurum var ise aktarırken "B - E aralığını" aynı kurumları alt alta aktarsın.
2 - Aktarma işlemi "B - E aralığı" yapılırken "C Sütununda" alt kurum adlarına göre A-Z şeklinde sıralama yapsın.

Teşekkür ederim.

 

[Necdet]

Merhaba,

Anlaşılsın diye soruyorum. Örneğinizde sadece A Kurumu olan satırlar mı (2 adet) aktarılacak?

 

[asi_kral]

Merhaba
1 - Aktarım yapılacak kurum adını nereden bilecek.
2 - Aktarım yaptıktan sonra harfe göre sıralama yaparsa sıralama veri tabanına göre farklı olmayacak mı_?
3 - Sıra numarası verilecek mi_?

 

[sirkülasyon]

Necdet Abi selamün aleyküm.
Hayır abi
Sayfa1 de B-E aralığı sayfa2 de ki B-E aralığına aktarılacak.
Sayfa1 de KURUM ADI aynı ve ALT KURUM ADI farklı olacağından
B-E aralığını aktarırken ALT KURUM adlarını A-Z olarak dizili aktarmasını talep ettim.

 

[Necdet]

Necdet Abi selamün aleyküm.
Hayır abi
Sayfa1 de B-E aralığı sayfa2 de ki B-E aralığına aktarılacak.
Sayfa1 de KURUM ADI aynı ve ALT KURUM ADI farklı olacağından
B-E aralığını aktarırken ALT KURUM adlarını A-Z olarak dizili aktarmasını talep ettim.

Merhaba,

Ben aktarılacak sütunlardan söz etmiyorum. sayfa1 de hangi firmalar aktarılacak, örneğinizde A kurumu 2 adet var ve alt kurumu da mevcut.

Bu 2 satır mı aktarılacak diye soruyorum. Sayın asi_kral'da aynı anlama gelecek soruları sormuş, yanıtlamamışsınız.

 

[sirkülasyon]

Sayın asi_kral ve Sayın Necdet Yeşertener abilerimden özür diliyorum.

Aktarım yapılacak kurum adı seçimi ile bir açıklamada bulunmamışım. Gerçi onu düşünemedim de.
Sayfa1 de kurum seçimini kurum adına çift tık ile yapabilmemiz mümkün mü? Sıra numarası vermeye gerek yok asi_kral abim.

 

[asi_kral]

Merhaba
Sayfa1'in kod bölümüne kopyalayın ve deneyin.

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim S1 As Worksheet, STR As Long, STR1 As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Set S1 = Sheets("Sayfa2")
STR = S1.Range("B" & Rows.Count).End(xlUp).Row + 1
If Intersect(Target, Range("B7:B" & Rows.Count)) Is Nothing Then _
Application.EnableEvents = True: Application.ScreenUpdating = True: _
Exit Sub
STR1 = Range("A" & Rows.Count).End(xlUp).Row
With WorksheetFunction
Range("A6:E" & STR1).AutoFilter 2, Target
If .Subtotal(3, Range("A7:A" & STR1)) > 1 Then
Range("B7:E" & STR1).Copy S1.Range("B" & STR)
End If
Range("A6:E" & STR1).AutoFilter
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Çift tıkladığınız kurumun verilerini aktarır.

 

[sirkülasyon]

Sayın Asi kral Teşekkür ederim.
Kusurum oldu ise bağışlayın.

 

[sirkülasyon]

Sayın asi_kral abim
makro bazen gıcıklık ediyor. Sayfa1 B7 den itibaren çift tıkladığım kurum adlarının bazılarını aktarmıyor.
Kontrol edebilir misiniz?

 

[asi_kral]

Sayın asi_kral abim
makro bazen gıcıklık ediyor. Sayfa1 B7 den itibaren çift tıkladığım kurum adlarının bazılarını aktarmıyor.
Kontrol edebilir misiniz?

Ne zaman yapıyor söylerseniz bakayım tekrardan