• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Her sayfada çalışsın

Katılım
14 Haziran 2006
Mesajlar
575
Sub Makro3düsara()

Range("P2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],Nadir!R2C2:R500C15,5,0)"
Range("P2").Select
Selection.AutoFill Destination:=Range("P2:R2"), Type:=xlFillDefault
Range("P2:R2").Select
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],Nadir!R2C2:R500C15,6,0)"
Range("Q3").Select
Sheets("KW17").Select
Range("R2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],Nadir!R2C2:R500C15,7,0)"
Range("P2:R2").Select
Selection.AutoFill Destination:=Range("P2:R1234")
Range("P2:R1234").Select
ActiveWindow.SmallScroll Down:=21
Range("T53").Select
ActiveWindow.SmallScroll Down:=-33
Range("R2").Select
Sheets("Nadir").Select
Range("N15").Select
Sheets("KW17").Select
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],Nadir!R2C2:R500C15,6,0)"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],Nadir!R2C2:R500C15,7,0)"
Range("P2:R2").Select
Selection.AutoFill Destination:=Range("P2:R1234")
Range("P2:R1234").Select
Range("P1").Select
Yoksifirsil
End Sub

kod sadece KW17. sayfada çalışıyor.Sayfalar KW18,KW19 diyerek gidiyor
Sheets("KW17").Select bu tanımı diğer sayfalarda çalışması için nasıl değiştirebiliriz.
 
Merhaba
Ne yapmak istediğinizi
detayları ile
örnek bir dosya ile anlatırsanız daha çabuk yardım alırsınız
 
Nadir sayfasındaki sütunlardan diğer açtığım her yeni sayfaya veri aldırmak istiyorum.
Açtığım yeni sayfanın K sütununu Nadir sayfasının B Sütunu ile karşılaştıracak var olan verileri Nadir sayfasındaki F,G,H sütunlarını Kodu çalıştırdığım sayfadaki P,Q,R sütunlarına yazdıracak.
 

Ekli dosyalar

Bakın örneği ekleyince cevap hemen geliyor.
Kod:
Sub Makro1düss()
'
' Makro1 Makro
'

'
For Each sh In Sheets
If Not sh.Name = "Nadir" Then
sh.Select

    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],Nadir!R2C2:R500C8,5,0)"
    Range("P2").Select
    Selection.AutoFill Destination:=Range("P2:P10"), Type:=xlFillDefault
    Range("P2:P10").Select
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],Nadir!R2C2:R500C8,6,0)"
    Range("Q2").Select
    Selection.AutoFill Destination:=Range("Q2:Q10"), Type:=xlFillDefault
    Range("Q2:Q10").Select
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],Nadir!R2C2:R500C8,7,0)"
    Range("R2").Select
    Selection.AutoFill Destination:=Range("R2:R10"), Type:=xlFillDefault
    Range("R2:R10").Select
    Range("A1").Select
    ActiveWindow.SmallScroll Down:=-6
End If
Next
End Sub
 
Sayfaların her hangi birinde düğmeye basarsanız. Otomatik olarak tüm sayfalardaki veriler günceller. Bu şekilde mi istediğiniz.
 
Merhaba
Dener misiniz

Kod:
Sub numan()
Dim x As Long
On Error Resume Next
Range("P2:R" & Count.Rows).ClearContents
Application.ScreenUpdating = False
son1 = Sheets("Nadir").Cells(Rows.Count, "B").End(3).Row
Alan = "B2:H" & son1
For x = 2 To son1
Range("P" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("Nadir").Range(Alan), 5, 0)
Range("Q" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("Nadir").Range(Alan), 6, 0)
Range("R" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("Nadir").Range(Alan), 7, 0)
Next x
Application.ScreenUpdating = True
End Sub
 
Kod ne kadar sayfa açsamda çalışıyor diğer sayfalarada zarar vermiyor istediğim gibi oldu emeğiniz için teşekkürler.
 
İyi çalışmalar
 
Geri
Üst