2 farklı aramayı aynı anda yapmak

[Armani]

Günaydın arkadaşlar.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Sheets("Konserve").[2:65536].Delete
Workbooks.Open Filename:="d:\ankara.xls"
Workbooks("Ankara.xls").Activate
Sheets("Bkz_12").Select
Sheets("Bkz_12").[a2:r65536].Sort Key1:=Sheets("Bkz_12").[r2]
ilksat = Sheets("Bkz_12").[r1:r65536].Find(10).Row
sonsat = WorksheetFunction.CountIf(Sheets("Bkz_12").[r1:r65536], 10) + ilksat - 1
Sheets("Bkz_12").Rows(ilksat & ":" & sonsat).Copy
Workbooks("New_Sablon.xls").Activate
Sheets("Konserve").Rows(2).PasteSpecial Paste:=xlAll
' Buraya kadar leventM arkadaşımın verdigi kodu kullanıyorum herşey normal ama diğer seçimli kodu bir türlü yazamadım 

Workbooks("Ankara.xls").Activate
ilksat1 = Sheets("Bkz_12").[r1:r65536].Find(15).Row
sonsat1 = WorksheetFunction.CountIf(Sheets("Bkz_12").[r1:r65536], 15) + ilksat - 1
Sheets("Bkz_12").Rows(ilksat1 & ":" & sonsat1).Copy
Workbooks("New_Sablon.xls").Activate
' Son satiri bul
Dim P, SonSatir1, LessThenOneCount1, r, t, y
   SonSatir1 = 0
  Do
    SonSatir1 = SonSatir1 + 1
    r = 1
      
  Loop Until ((Sheets("Konserve").Cells(SonSatir1 + 1, 1) = "") And _
              (Sheets("Konserve").Cells(SonSatir1 + 1, 2) = ""))
      r = 1
  
' **** son satiri bulunca buraya diğer sonuçları aktarmak istiyorum ****

Application.CutCopyMode = False

Yukarıdaki kod da göreceginiz amacım bölüm numarası 10 ve 15 i aynı sayfada göstermek istiyorum.

İzledigim yol yanlışmı ?

Teşekkürler

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

[vb:1:f979079b06]Application.ScreenUpdating = False
Sheets("Konserve").[2:65536].Delete
Workbooks.Open Filename:="d:\ankara.xls"
Workbooks("Ankara.xls").Activate
Sheets("Bkz_12").Select
Sheets("Bkz_12").[a2:r65536].Sort Key1:=Sheets("Bkz_12").[r2]
ilksat = Sheets("Bkz_12").[r1:r65536].Find(10).Row
sonsat = WorksheetFunction.CountIf(Sheets("Bkz_12").[r1:r65536], 10) + ilksat - 1
Sheets("Bkz_12").Rows(ilksat & ":" & sonsat).Copy
Workbooks("New_Sablon.xls").Activate
Sheets("Konserve").Rows(2).PasteSpecial Paste:=xlAll
' Buraya kadar leventM arkadaşımın verdigi kodu kullanıyorum herşey normal ama diğer seçimli kodu bir türlü yazamadım

Workbooks("Ankara.xls").Activate
ilksat1 = Sheets("Bkz_12").[r1:r65536].Find(15).Row
sonsat1 = WorksheetFunction.CountIf(Sheets("Bkz_12").[r1:r65536], 15) + ilksat1 - 1
Sheets("Bkz_12").Rows(ilksat1 & ":" & sonsat1).Copy
Workbooks("New_Sablon.xls").Activate

sondakisatir = Sheets("Konserve").[b65536].End(xlUp).Row 'sondaki satırı bulur

Sheets("Konserve").Rows(sondakisatir + 1).PasteSpecial Paste:=xlAll
Application.CutCopyMode = False
[/vb:1:f979079b06]

 

[Armani]

sondakisatir = Sheets("Konserve").[b65536].End(xlUp).Row 'sondaki satırı bulur

Malesef bu kod son satırı bulmuyor

 

[Armani]

pardon buluyor....

paste ederken problemi var.

 

[Levent Menteşoğlu]

Yukarıdaki kodda ilksat1 yazılması gerekirken ilksat yazmışım bu düzeltmeyi yaptım. Bu haliyle tekrar deneyin.

 

[Armani]

Onu fark etmişdim leventm..

Sheets("Konserve").Rows(sondakisatir + 1).PasteSpecial

ilgili satırı;

Sheets("Konserve").Cells(sondakisatir + 1, "a").PasteSpecial Paste:=xlAll

şeklinde değitirince problemler giderildi.

ilgine çok teşekkürler