Hücredeki İsimle Sayfa Açıp Veri Aktarmak

[SİBEL70]

Merhabalar,

Ekteki dosyada Rapor adlı sayfadan firma ismi seçerek şablon sayfasını kopyalayarak, firma ismiyle yeni sayfa oluşturuyorum. Yapmak istediğim firma aktar düğmesine basıldığında firmaya ait bütün verileri ,data sayfasından alarak firmanın açılan sayfasına d11 den başayacak şekilde aktarması. Firma sayfasında daha önceden kayıtlı veri varsa bu veriler silinecek ve data sayfasından yeniden alınacak. Firmanın sayfası yoksa önce sayfayı açıp sonra verileri aktaracak. Bu konuda yardımcı olabilirseniz sevinirim.

Saygılar,

 

[Ömer]

Merhaba,

Linki inceleyiniz..

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

.

 

[SİBEL70]

Sayın Ömer,

Vermiş olduğunuz link için teşekkür ediyorum. Ancak benim ihtiyacım olan listeden sadece seçtiğim firmanın aktarılması. Yüzlerce firma olabiliyor ama benim bazılarını raporlamam gerekiyor dolayısıyla bu şekilde bütün firmalara sayfa açarsam dosya boyutunu çok büyütüyor.

Saygılar,

 

[Ömer]

Bu şekilde deneyiniz..

Sub Dikdörtgen_Tıklat()
 
Dim c As Range, sat As Long, ilkadres As Variant
Dim S1 As Worksheet, S2 As Worksheet
 
Set S1 = Sheets("DATA")
Set S2 = Sheets("RAPOR")
 
If SayfaVarMi(Range("D2")) Then
    Sheets("" & Range("D2") & "").Select
Else
    Sheets("ŞABLON").Copy Before:=Sheets(1)
    ActiveSheet.Select
    ActiveSheet.Name = S2.Range("D2")
End If
 
Range("B11:I65536").ClearContents
 
sat = 10
With S1.Range("E:E")
    Set c = .Find(S2.Range("D2"), LookIn:=xlValues)
    If Not c Is Nothing Then
        ilkadres = c.Address
        Do
            sat = sat + 1
            Range("B" & sat & ":I" & sat) = S1.Range("C" & c.Row & ":J" & c.Row).Value
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> ilkadres
    End If
End With
 
End Sub
 
Function SayfaVarMi(SayfaAdi As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function

.

 

[SİBEL70]

Sayın Ömer,

Yardımınız için teşekkür ederim. Saygılar..