SEÇİMLİ HÜCREDEN MAKROYA ETKİ ETME

[excelience]

Merhaba arkadaşlar belirli bir sayfa için yazılmış makroda ki formülün belli bir sayfaya değilde sayfa seçim hücresiyle diğer sayfalara da etki etmesini istiyorum üstadlarımdan ricamdır Daha anlaşılabilir olması için örnek dosya mevcuttur şimdiden elleriniz dert görmesin teşekkürler

 

[derisa963]

@excelience Merhabalar dosyanızda hiç kod yok.
Bilgi Olaraktan diyelim ki "Ana Sayfa" ya sayfa1 deki ve sayfa 2 deki aynı alanlar isteğe göre gelecek . Ana sayfadaki "d2" Hücresinede sayfa isimleri var diyelim ve gelmesi gereken hücreler "A1:C10" olsu. Örnek kod olarak:

On Error exit sub
Dim eipk As Worksheet: Set eipk = Sheets("Ana Sayfa")
Dim s1 As Worksheet: Set s1 = Sheets(eipk.Range("D2").value)
eipk.Range("A1:C10").value = s1.Range("A1:C10").value
Msgbox("İşlem Tamamlandı.")

Kendiniz Bu Örnekteki Gibi Uyarlayabilirsiniz

 

[excelience]

@excelience Merhabalar dosyanızda hiç kod yok.
Bilgi Olaraktan diyelim ki "Ana Sayfa" ya sayfa1 deki ve sayfa 2 deki aynı alanlar isteğe göre gelecek . Ana sayfadaki "d2" Hücresinede sayfa isimleri var diyelim ve gelmesi gereken hücreler "A1:C10" olsu. Örnek kod olarak:

On Error exit sub
Dim eipk As Worksheet: Set eipk = Sheets("Ana Sayfa")
Dim s1 As Worksheet: Set s1 = Sheets(eipk.Range("D2").value)
eipk.Range("A1:C10").value = s1.Range("A1:C10").value
Msgbox("İşlem Tamamlandı.")

Kendiniz Bu Örnekteki Gibi Uyarlayabilirsiniz

Tekrardan merhaba hocam uyarlayamadım :/ bir göz atabilirmisiniz ? Makroyu aşağıya yazdım saygılar...

Sub YuvarlatılmışÇaprazKöşeliDikdörtgen2_Tıklat()

Dim syf(), sat As Long, i As Byte, son As Long

syf = Array("EYLÜL")
Application.ScreenUpdating = False
Sheets("ANASAYFA").Select
Range("A3:O" & Rows.Count).Clear

sat = 3
For i = 0 To UBound(syf)
With Sheets(syf(i))
son = .Cells(Rows.Count, "B").End(xlUp).Row
.Range("B4").Resize(son - 3, 3).Copy Cells(sat, "B")
.Range("BC4").Resize(son - 3, 2).Copy
Cells(sat, "E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
.Range("AK4").Resize(son - 3, 1).Copy
Cells(sat, "F").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
.Range("BA4").Resize(son - 3, 1).Copy
Cells(sat, "G").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
.Range("AT4").Resize(son - 3, 1).Copy
Cells(sat, "I").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
.Range("A4").Resize(son - 3, 1).Copy
Cells(sat, "K").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
.Range("BB4").Resize(son - 3, 1).Copy
Cells(sat, "L").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
.Range("AX4").Resize(son - 3, 1).Copy
Cells(sat, "M").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
sat = sat + son - 3
End With
Next i

Range("A3") = 1
Range("A3").Resize(sat - 3, 1).DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Date:=xlDay, Step:=1
Range("E:E").NumberFormat = "0%"
Range("F:J").NumberFormat = "#,##0.00 $"

Range("A3:N" & sat - 1).Borders.LineStyle = 1
Range("A3:N" & sat - 1).Interior.ColorIndex = 0

For i = 3 To Cells(Rows.Count, "B").End(xlUp).Row
Cells(i, "H") = Cells(i, "F") + Cells(i, "G")
Cells(i, "J") = Cells(i, "H") - Cells(i, "I")
Cells(i, "N") = Cells(i, "H") - Cells(i, "I")
If i Mod 2 = 0 Then
Cells(i, "A").Resize(1, 14).Interior.ThemeColor = xlThemeColorDark2
End If
Next i

Application.ScreenUpdating = True

End Sub

 

[derisa963]

sayın @excelience Merhabalar Örnek Dosyanız İndirmeK için tıklayınız.