Mdemir63
Altın Üye
- Katılım
- 7 Temmuz 2006
- Mesajlar
- 2,989
- Excel Vers. ve Dili
- Ofis2010 32Bit Türkçe
Selamlar,
Örnek dosyanızı eklerseniz daha faydalı olacaktır.
Hocam günaydın
dosyanın boyutu büyük olduğundan hotmail adresinize gönderdim
Saygılar
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Selamlar,
Örnek dosyanızı eklerseniz daha faydalı olacaktır.
Cells(SONSAT, 1).Value = SONSAT - 1
Sub AKTAR()
Set SÇ = Sheets("Çalışma Sayfası")
Set SS = Sheets("Sonuç")
SS.[A2:J65536].ClearContents
FİRMA = Application.InputBox("Lütfen ekstresi alınacak firma adını giriniz.", "FİRMA ADI GİRİNİZ")
If FİRMA = False Then Exit Sub
If WorksheetFunction.CountIf(SÇ.[B:B], FİRMA) = 0 Then Exit Sub
SÇ.[B2].AutoFilter Field:=2, Criteria1:=FİRMA
SS.[A2] = FİRMA
For X = 2 To 11
SS.Cells(2, X) = SÇ.Cells(65536, X + 2)
Next
SÇ.[B2].AutoFilter Field:=2
MsgBox "Cari hesap ekstresi oluşturulmuştur.", vbInformation
End Sub
Selamlar,
Çalışmanızdaki aşağıdaki kodun sonundaki 2 rakamını tekrar 1 olarak değiştirin.
Kod:Cells(SONSAT, 1).Value = SONSAT - 1
Ayrıca aktarım için vermiş olduğum koduda aşağıdaki şekilde değiştirip denermisiniz.
[/QUOTKod:Sub AKTAR() Set SÇ = Sheets("Çalışma Sayfası") Set SS = Sheets("Sonuç") SS.[A2:J65536].ClearContents FİRMA = Application.InputBox("Lütfen ekstresi alınacak firma adını giriniz.", "FİRMA ADI GİRİNİZ") If FİRMA = False Then Exit Sub If WorksheetFunction.CountIf(SÇ.[B:B], FİRMA) = 0 Then Exit Sub SÇ.[B2].AutoFilter Field:=2, Criteria1:=FİRMA SS.[A2] = FİRMA For X = 2 To 11 SS.Cells(2, X) = SÇ.Cells(65536, X + 2) Next SÇ.[B2].AutoFilter Field:=2 MsgBox "Cari hesap ekstresi oluşturulmuştur.", vbInformation End Sub
Hocam sizi yordum çok teşekkür ederim
Saygılar