listeye göre sayfa açma ve değerleri getirme

[Erdem Akdemir]

Arkadaşlar merhaba

Ekteki soruda kullanıcı bilgileri bölümündeki plaka göre sayfalar açacak ve sayfanın plaka adına göre bilgiler araç sayfasından yazılacak

ekte herşey daha net biçimde gözüküyor, aşağıdaki kodu yazdım ama olmadı

iyi çalışmalar...

Private Sub CommandButton1_Click()

For a = 2 To Sheets("KULLANICI BİLGİLERİ").Range("a65536").End(3).Row
Sheets("sayfa1").Copy After:=Sheets(Sheets.Count)

sat = Worksheets("Sayfa1").[a65536].End(3).Row + 1
For j = 1 To 22
aranan1 = Worksheets("KULLANICI BİLGİLERİ").Cells(j, "A").Value
For i = 1 To Worksheets("ARAÇ").[a65536].End(3).Row
aranan2 = Worksheets("ARAÇ").Cells(i, j).Value

If aranan1 <> "" Then
If aranan2 <> "" Then
If aranan1 = aranan2 Then
For r = 1 To 22
Sheets(Sheets.Count).Cells(sat, r).Value = Worksheets("ARAÇ").Cells(i, r).Value
Next r
sat = sat + 1
End If
End If
End If
Next i
Next j
Sheets(Sheets.Count).Name = Sheets("KULLANICI BİLGİLERİ").Range("a" & a)
Next a
MsgBox "işlem tamam"
End Sub

 

[Erdem Akdemir]

Private Sub CommandButton1_Click()

For a = 2 To Sheets("KULLANICI BİLGİLERİ").Range("a65536").End(3).Row
Sheets("sayfa1").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheets("KULLANICI BİLGİLERİ").Range("a" & a)

sat = Worksheets("Sayfa1").[a65536].End(3).Row + 1
For j = 1 To 22
aranan1 = ActiveSheet.Name
For i = 1 To Worksheets("ARAÇ").[a65536].End(3).Row
aranan2 = Worksheets("ARAÇ").Cells(i, j).Value

If aranan1 <> "" Then
If aranan2 <> "" Then
If aranan1 = aranan2 Then
For r = 1 To 22
ActiveSheet.Cells(sat, r).Value = Worksheets("ARAÇ").Cells(i, r).Value
Next r
sat = sat + 1
End If
End If
End If
Next i
Next j
Next a
MsgBox "işlem tamam"
End Sub

arkadaşlar merhaba

kodu yukarıdaki gibi yaptım ama run time error hatası alıyorum

tek bir sayfa kopyalıyor, diğer plakalar içim işlem yapıyor

yardımlarınız çok önemli, iyi çalışmalar

 

[Ömer]

Merhaba,

Linki inceleyiniz..

http://www.excel.web.tr/showthread.php?t=84504&highlight=Worksheets.Count

.

 

[Orion1]

Dosyanız ektedir.

Sub Resim23_Tıklat()
Dim s1 As Worksheet, s2 As Worksheet, sat1 As Long, sat2 As Long
Set s1 = Sheets("ARAÇ")
Set s2 = Sheets("KULLANICI BİLGİLERİ")
s1.Range("A1").AutoFilter
s2.Range("A1").AutoFilter
sat1 = s1.Cells(65536, "B").End(xlUp).Row
sat2 = s2.Cells(65536, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To sat2
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = s2.Cells(i, "A").Value
    s1.Range("A1").AutoFilter field:=2, Criteria1:=s2.Cells(i, "A").Value
    s1.Range("A1").CurrentRegion.Copy ActiveSheet.Range("A1")
Next i
s1.Range("A1").AutoFilter
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[Erdem Akdemir]

cevap veren herkese teşekkür ederim