Dosyayı sayfaya aktarırken sorun

[Mx@Raid]

[ÇÖZÜLDÜ]Dosyayı sayfaya aktarırken sorun

Arkadaşlar ekteki dosya da verileri diğer sayfaya aktarma yöntemi kullanıyorum.
Yalnız aktarırken başlığı dahil etmesini istemiyorum. bunun için nasıl bir değişiklik yapmalıyım.

 

[Korhan Ayhan]

Selamlar,

Dosyanız zaten bu haliyle başlığı aktarmaz.

 

[Mx@Raid]

Sn Korhan Ayhan Sh.Rows("2:47")... bu olduğu zaman başlıkları siliyor. Yalnız benim istediğim bu komuta ihtiyaç duymadan çözebilmek.

 

[Korhan Ayhan]

Selamlar,

Belirtmediğiniz için ben modüldeki kodu denemiştim. Sayfanızın arka planında çalıştırdığınız kodun yazılım mantığı bence doğru değil. Ne yapmak istediğinizi açıklarsanız daha etkin bir kod önerebiliriz.

 

[Mx@Raid]

Sn. Korhan Ayhan amacım ilgili sütunlara çift tık yaptığımda sayfayı belirtilen sayfaya ya da kitaba aktarması

 

[Korhan Ayhan]

Selamlar,

Anladığım kadarıyla 4 farklı rapor almak istiyorsunuz. Fakat aktarım yapılacak sayfalardaki bilgilerin hepsi aynı. Neden aynı formatta 4 farklı sayfaya aktarım yapmak istediğinizi anlayamadım. Yada benim atladığım bir detaymı var. Açıklarmısınız. Sizin yapacağınız detaylı açıklamaya göre çözüm üretebiliriz.

 

[Mx@Raid]

Sn. Korhan Ayhan aslında benim amacım rapor, rapor1 ... adlı kitaplara dosyayı aktarmak ve örneğin a2 hücresinde ki değerle aynı olanları diğer sayfaya ya da bir çalışma kitabı oluşturarak oraya aktarmasını sağlamak. (Bu b hücresi ya da c ya da d hücresi içinde böyle) bir sayfaya aktarma veya bir çalışma kitabına aktarma mantığını öğrenmek amacım işin özeti.

 

[Korhan Ayhan]

Selamlar,

Ekte dosyanız üzerinde gerekli düzenlemeleri yaptım. İlgili sütunlarda hücrelere çift tıklayınca ayrı bir dosyaya verileri aktarmaktadır ve dosyayı kaydedip kapatmaktadır. Rapor dosyaları veri dosyanızın bulundu yere kayıt edilmektedir.

Kullanılan kod;

Option Explicit
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("A2:H65536")) Is Nothing Then Exit Sub
 
    Cancel = True
 
    If Target <> "" Then
 
    Application.ScreenUpdating = False
 
    If ActiveSheet.AutoFilterMode Then Sheets("DATA").Range("A1").AutoFilter
 
    If Target.Column = 1 Then
        Sheets("DATA").Range("A1").AutoFilter Field:=Target.Column, Criteria1:=CDate(Target)
        ElseIf Target.Column = 2 Then
        Sheets("DATA").Range("A1").AutoFilter Field:=Target.Column, Criteria1:=Format(Target, "dd mmmm yyyy dddd")
        ElseIf Target.Column = 7 Then
        Sheets("DATA").Range("A1").AutoFilter Field:=Target.Column, Criteria1:=Format(Target, "hh:mm;@")
        Else
        Sheets("DATA").Range("A1").AutoFilter Field:=Target.Column, Criteria1:=Target
    End If
 
        Sheets("DATA").Range("A1").CurrentRegion.Copy
        Workbooks.Add (1)
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveSheet.Cells.EntireColumn.AutoFit
        ActiveSheet.Range("A1").Select
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\RAPOR_" & Target.Column & ".xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        ActiveWorkbook.Close False
        Application.DisplayAlerts = True
 
    End If
    Sheets("DATA").Range("A1").AutoFilter
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Mx@Raid]

Sn. Korhan bey emeğinize,yüreğinize sağlık; çok teşekkür ederim. Bunu sayfa olarak yapmak istersek kodu nasıl değiştirebiliriz.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyada aynı dosya içinde çift tıklama ile farklı sayfalara raporlama yapılmaktadır. İncelermisiniz.

Bir önceki mesajımdaki örnek dosyada ve kodda küçük bir düzenleme yaptım. Gereksiz bir değişken kullanmışım. Onu kaldırdırm. Lütfen son halini kullanınız.

Kullanılan kod;

Option Explicit
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("A2:H65536")) Is Nothing Then Exit Sub
 
    Cancel = True
 
    If Target <> "" Then
 
    Application.ScreenUpdating = False
 
    If ActiveSheet.AutoFilterMode Then Sheets("DATA").Range("A1").AutoFilter
 
    If Target.Column = 1 Then
        Sheets("DATA").Range("A1").AutoFilter Field:=Target.Column, Criteria1:=CDate(Target)
        ElseIf Target.Column = 2 Then
        Sheets("DATA").Range("A1").AutoFilter Field:=Target.Column, Criteria1:=Format(Target, "dd mmmm yyyy dddd")
        ElseIf Target.Column = 7 Then
        Sheets("DATA").Range("A1").AutoFilter Field:=Target.Column, Criteria1:=Format(Target, "hh:mm;@")
        Else
        Sheets("DATA").Range("A1").AutoFilter Field:=Target.Column, Criteria1:=Target
    End If
 
        Sheets("DATA").Range("A1").CurrentRegion.Copy Sheets("RAPOR_" & Target.Column).Range("A1")
        Sheets("RAPOR_" & Target.Column).Select
        ActiveSheet.Cells.EntireColumn.AutoFit
        ActiveSheet.Range("A1").Select
 
    End If
    Sheets("DATA").Range("A1").AutoFilter
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Mx@Raid]

Korhan Bey çok teşekkür ederim zahmet verdim. Yüreğinize, emeğinize sağlık.