Kod Kopyalama

[g_demir]

Sheets("1").Select
Range("c4").Select
Selection.Copy
Sheets("Ödemeler").Select
Range("b3").Select
ActiveSheet.Paste Link:=True
Sheets("1").Select
Range("c8").Select
Selection.Copy
Sheets("Ödemeler").Select
Range("c3").Select
ActiveSheet.Paste Link:=True
Sheets("1").Select
Range("m25").Select
Selection.Copy
Sheets("Ödemeler").Select
Range("D3").Select
ActiveSheet.Paste Link:=True

arkadaşlar yukarıdaki kodları makro kaydetle elde ettim güzel işime yarıyor fakat bende 200 tane sayfa var ve hepsine bunu yapmak ıstıyorum bır butona bastıgımda otomatik olarak 200 sayfadak1 sectım hücreler Ödemeler sayfasındakı yerlere gelmesi gerekiyor bunu daha cabuk ve basıtce yapmanın bir yolu varmı sizce?

 

[accilisse]

örnek dosya gönderirsen daha iyi olur

 

[Orion1]

Aşağıdaki kodu deneyiniz.

Sub kopyala()
Dim i As Integer
Application.ScreenUpdating = False
For i = 1 To Worksheets.Count
If Sheets(i).Name <> "1" Then
Sheets("1").Select
Range("c4").Select
Selection.Copy
Sheets(i).Select
Range("b3").Select
ActiveSheet.Paste Link:=True
Sheets("1").Select
Range("c8").Select
Selection.Copy
Sheets(i).Select
Range("c3").Select
ActiveSheet.Paste Link:=True
Sheets("1").Select
Range("m25").Select
Selection.Copy
Sheets(i).Select
Range("D3").Select
ActiveSheet.Paste Link:=True
End If
Next i
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

 

[g_demir]

evet tam istedigi gibi koplayadı teşekkür ederim ama sadece ilk 4 sayfayı koplayadı neden gerisini kopyalamadı hata bendemi acaba ?

 

[Orion1]

evet tam istedigi gibi koplayadı teşekkür ederim ama sadece ilk 4 sayfayı koplayadı neden gerisini kopyalamadı hata bendemi acaba ?

Bütün sayfaları kopyalaması gerekiyor.

 

[g_demir]

ilginiz için teşşekür ederim fakat cok fazla bilgi sahibi olmadığımdan tam olarak anlamadm sanırım örnegı ekte gönderiyorum en azından bir iki sayfa ıcın yaparsanız cok sevınırım

 

[Orion1]

Kopyalanan yerlerde birleştirilmiş hücreler var kod ondan çalışmıyor.Ben birleştirilmiş hücreleri çözdüm.
Ekli dosyayı inceleyiniz.

 

[Zeki Gürsoy]

Sub kopyala2()
Dim i As Integer
 
For i = 1 To Worksheets.Count
 
    If Sheets(i).Name <> "1" Then
 
        Sheets(i).Range("b3").Formula = _
            "='1'!" & Sheets("1").Range("c4").Address
 
        Sheets(i).Range("c3").Formula = _
            "='1'!" & Sheets("1").Range("c8").Address
 
        Sheets(i).Range("d3").Formula = _
            "='1'!" & Sheets("1").Range("m25").Address
 
    End If
 
Next i
 
End Sub

Manuel;

Sayfa adı "1" dışındakilerin tümü seçilip, seçili sayfaların herhangi birinde "b3" hücresine doğrudan ='1'!C4 yazılabilir.