sayfada çift tıklayınca yeni sayfa açarak bellli aralığı kopyalama

[orcunerkek]

herkese iyi tatilller. şu şekilde bir yardıma ihtiyacım var. Sayfa1 de H sütununda içinde POZ1, POZ2 ve POZ3 yazan hücrelerden birine çift tıkladığımda tıkladığım hücreden itibaren 4 hücre yukarıdan başlayarak aşağıya doğru A ve G arasını kopyalayarak 250 hücre aşağıya kadar kopyalayarak yeni sayfa açacak ve sayfa adını tarih ve saat olarak verecek.
H14'e çift tıkladığımda (eğer mümkünse içinde POZ1, POZ2 ve POZ3 yazıyorsa) A10'dan G250'ye kadar olan kısmı kopyalayıp yeni sayfaya adını tarih saat vererek kopyalayacak.

bu konuda yardımcı olabilirseniz sevinirim. herkese şimdiden teşekkürler.

 

[Murat OSMA]

Merhaba,
Bu kodları sayfanın kod kısmına yapıştırıp H14'de çift tıklayın.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    If Target.Address(0, 0) = "H14" Then
        Select Case Target.Value
            Case "POZ1", "POZ2", "POZ3"
            Sheets.Add After:=Sheets(Worksheets.Count)
            ActiveSheet.Name = Replace(Now, ":", "-")
            Sheets("Sayfa1").Range("A10:G250").Copy ActiveSheet.Range("A1")
        End Select
    End If
End Sub

 

[orcunerkek]

Syn murat bey cevap icin tesekur ederim.H sütununda herhangi bir sutunu (içinde poz yazan ) cift tikladigimda sectigim yerden 4 sütun öncesinden başlayarak işlem yapması gerekiyor. Bu sekilde duzenlemeniz mumkunmu. Ornegin H12 yi s ecersem H8 eden itibaren AIle G arasinida 250 satır H24 u secersem H20 den itibaren A ile G arasında 250 satır secip yeni sayfaya kopyalasin. Tesekkurler

 

[Murat OSMA]

Böyle bir deneyin..

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    If Target.Column = 8 Then
        Select Case Target.Value
            Case "POZ1", "POZ2", "POZ3"
            Sheets.Add After:=Sheets(Worksheets.Count)
            ActiveSheet.Name = Replace(Now, ":", "-")
            Sheets("Sayfa1").Range("A" & target.row -4 & ":" & target.row + 246).Copy ActiveSheet.Range("A1")
        End Select
    End If
End Sub

 

[orcunerkek]

çok teşekkürler elinize sağlık

 

[Murat OSMA]

Rica ederim, iyi geceler.