Vb kodunu digerlerinde uygulayamıyorum

[mulk]

Bir çalışma var ekte a hücresine tıkladımmı aynı isimleri raporluyor ama ben diger hücrelerdede aynısını yapmak istiyorum yardımcı olursanız sevinirim

 

[mulk]

Dosyayı

Ekledim dosyayı inşallah bakarsanız sevinirim

 

[mulk]

:s KİMSE YARDIMCI OLMUYACAKMI

 

[parametre]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
Application.ScreenUpdating = False
If Intersect(Target, [A7:A65536]) Is Nothing Then Exit Sub
If Target = "" Then
Cancel = True
Exit Sub
End If
Cancel = True
Sheets("RAPOR").Range("A7:I65536").ClearContents
Sheets("RAPOR").Range("A7:I65536").Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("RAPOR").Range("A7:I65536").Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("RAPOR").Range("A7:I65536").Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("RAPOR").Range("A7:I65536").Borders(xlEdgeTop).LineStyle = xlNone
Sheets("RAPOR").Range("A7:I65536").Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("RAPOR").Range("A7:I65536").Borders(xlEdgeRight).LineStyle = xlNone
Sheets("RAPOR").Range("A7:I65536").Borders(xlInsideVertical).LineStyle = xlNone
Sheets("RAPOR").Range("A7:I65536").Borders(xlInsideHorizontal).LineStyle = xlNone

Selection.AutoFilter Field:=1, Criteria1:=Target
Range("B7:I7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("RAPOR").Select
Sheets("RAPOR").Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("RAPOR").Range("A4") = Target
Sheets("RAPOR").Range("A6:I6").Select
Sheets("RAPOR").Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Sheets("RAPOR").Range("I2").Formula = "=SUBTOTAL(9,H7:H65536)"
Sheets("RAPOR").Range("I3").Formula = "=SUBTOTAL(9,G7:G65536)"

Sheets("RAPOR").Range("A1").Select
Sheets("VERİ").Select
Selection.AutoFilter Field:=1
Range("A7").Select
MsgBox Target & Chr(13) & Chr(13) & "İSİMLİ FİRMANIN CARİ HESAP EXTRESİ BAŞARIYLA OLUŞTURULMUŞTUR.", vbInformation
Application.ScreenUpdating = True
End Sub

bu kodu yapmak istediginiz satırla değiştiriniz a hucresi ile ilgili olan bolumu istediğiniz hucre ile degiştirebilirsiniz kolay gelsin bir tane kırmızı olarak yazdım

 

[mulk]

bu kodu yapmak istediginiz satırla değiştiriniz a hucresi ile ilgili olan bolumu istediğiniz hucre ile degiştirebilirsiniz kolay gelsin bir tane kırmızı olarak yazdım

yardımcı oldugunuz için teşekkür ama benim istedigim a hücresi b hücresi c hücresi hepsi bir olabiliyormu _? aynı anda yani hata veriyor o şekilde yapıldımmı