• DİKKAT

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

Macro diğer sayfalarda çalışsın

N

nadirornek

Katılım
14 Haziran 2006
Mesajlar
575
Merhaba,

Sub za53()
Application.CursorMovement = False
Columns("M:M").Select
Selection.ClearContents
Columns("P:V").Select
Selection.ClearContents
Range("T1").Select
MsgBox "veriler silindi"
Düs
Yoksifirsil
aktar
reng
Application.CursorMovement = True
End Sub

Çalışma kitabımda;Sayfa1,veri,Çalışma sayfaları hariç diğer bulunan sayfalarda za53 macromun çalışmasını istiyorum.Kodta ne gibi değişiklik yapabilirim teşekkürler.
 
kod
Rich (BB code): 
Sub za53()

If ActiveSheet.Name = "Sayfa1" Or ActiveSheet.Name = "veri" Then

Application.CursorMovement = False
Columns("M:M").Select
Selection.ClearContents
Columns("P:V").Select
Selection.ClearContents
Range("T1").Select
MsgBox "veriler silindi"
Düs
Yoksifirsil
aktar
reng
Application.CursorMovement = True

End If

End Sub
 
birde bunu dene

Rich (BB code): 
Sub za53()

If ActiveSheet.Name <> "Sayfa1" Or ActiveSheet.Name <> "veri" Then

Application.CursorMovement = False
Columns("M:M").Select
Selection.ClearContents
Columns("P:V").Select
Selection.ClearContents
Range("T1").Select
MsgBox "veriler silindi"
Düs
Yoksifirsil
aktar
reng
Application.CursorMovement = True

End If

End Sub
 
kod çalışmadı derken hiç işlem yapmıyormu?
ben dosyanıza sadece kırmızı yerleri ekliyorum.

birde bunu dene
Rich (BB code): 
Sub za53()

If ActiveSheet.Name = "Sayfa1" Then GoTo atla
If ActiveSheet.Name = "veri" Then GoTo atla

Application.CursorMovement = False
Columns("M:M").Select
Selection.ClearContents
Columns("P:V").Select
Selection.ClearContents
Range("T1").Select
MsgBox "veriler silindi"
Düs
Yoksifirsil
aktar
reng
Application.CursorMovement = True

atla:

End Sub
 
Son düzenleme:
Kod çalıştı fakat diğer sayfalarda işlem yapmıyor.
Örnek:Ben KW13 sayfasında kodu çalıştırdığım zaman diğer sayfalarda da işlem yapacak. İstemediğim sayfada işlem yapmayacak.
 
nadirornek' Alıntı:
Merhaba,

Çalışma kitabımda;Sayfa1,veri,Çalışma sayfaları hariç diğer bulunan sayfalarda za53 macromun çalışmasını istiyorum.Kodta ne gibi değişiklik yapabilirim teşekkürler.
Genişletmek için tıkla ...

6 nolu mesajdaki kod Sayfa1 ve veri sayfası hariç diğer bütün sayfalarda çalışmaktadır.
 
Son düzenleme:
Merhaba,
Örnek bir dosya ekledim.
Kodlarınız güzel çalışıyor, ama benim koda yaptırtmak isteğim Sayfa1 ve veri sayfaları hariç her hangi bir sayfada kodu çalıştırdığım zaman tüm sayfalarda aynı anda işlem yapıp çalışması.
 

Ekli dosyalar

kod:

Kod: 
Sub deneme()

Application.CursorMovement = False

For i = 1 To Sheets.Count

If Sheets(i).Name = "Sayfa1" Then GoTo atla
If Sheets(i).Name = "veri" Then GoTo atla

Sheets(Sheets(i).Name).Columns("M:M").ClearContents
Sheets(Sheets(i).Name).Columns("P:V").ClearContents

atla:

Next i

Application.CursorMovement = True
MsgBox "veriler silindi"
End Sub
 
Teşekkürler son hali çok güzel oldu.
Tanımlı aktar kodum var bu kodun neresine yazmam gerekiyor.İlaveler gerekiyormu.
 
aktar kodlarını görmemiz gerekiyor
 
Aşağıdaki kodları deneme kodunun içerisine yazıp çalıştırabilirmiyiz aynı mantıkla.

Sub aktar()
Dim a(), b(), c(), d As Object, deg As Variant
Dim i As Long, Y As Integer, Son1 As Long, Son2 As Long
Dim S1 As Worksheet, S2 As Worksheet
Set S1 = Sheets("Çalışma")
Set S2 = ActiveWorkbook.ActiveSheet
Set d = CreateObject("Scripting.Dictionary")
Son1 = S1.Cells(Rows.Count, "B").End(3).Row
a = S1.Range("B2:M" & Son1).Value
For i = 1 To UBound(a)
deg = ""
For Y = 1 To UBound(a, 2) - 1: deg = deg & a(i, Y): Next Y
d(deg) = a(i, UBound(a, 2))
Next i
Son2 = S2.Cells(Rows.Count, "N").End(3).Row
b = S2.Range("P2:Y" & Son2).Value
ReDim c(1 To UBound(b), 1 To 1)
For i = 1 To UBound(b)
deg = ""
For Y = 1 To UBound(b, 2): deg = deg & b(i, Y): Next Y
c(i, 1) = d(deg)
Next i
S2.Range("M2:M" & Rows.Count).ClearContents
S2.Range("M2").Resize(UBound(b)) = c

End Sub

Sub Düs()
Dim x As Long
On Error Resume Next
Range("P2:O" & Count.Rows).ClearContents
Application.ScreenUpdating = False
Son1 = Sheets("veri").Cells(Rows.Count, "B").End(3).Row
Son2 = ThisWorkbook.ActiveSheet.Cells(Rows.Count, "K").End(3).Row
Alan = "B2:O" & Son1
For x = 2 To Son2
Range("P" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("veri").Range(Alan), 5, 0)
Range("Q" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("veri").Range(Alan), 6, 0)
Range("R" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("veri").Range(Alan), 7, 0)
Range("S" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("veri").Range(Alan), 8, 0)
Range("T" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("veri").Range(Alan), 9, 0)
Range("U" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("veri").Range(Alan), 10, 0)
Range("V" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("veri").Range(Alan), 11, 0)
Range("W" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("veri").Range(Alan), 12, 0)
Range("X" & x).Value = WorksheetFunction.VLookup(Range("K" & x), Sheets("veri").Range(Alan), 13, 0)
Next x
Application.ScreenUpdating = True
End Sub
 
Son düzenleme:
Eklemiş olduğum dosyada işlemleri yapamazsanız bu kodu kullan

Kod: 
Sub deneme()

Application.CursorMovement = False

For i = 1 To Sheets.Count

If Sheets(i).Name = "Sayfa1" Then GoTo atla
If Sheets(i).Name = "veri" Then GoTo atla

Sheets(Sheets(i).Name).Columns("M:M").ClearContents
Sheets(Sheets(i).Name).Columns("P:V").ClearContents

Sheets(Sheets(i).Name).Select

aktar
Düs

atla:

Next i

Application.CursorMovement = True
MsgBox "veriler silindi"
End Sub
 
Kod çalışıyor güzel yalnız sayfalar arasında geziyor sonunda Microsoft Visual Basic for Applications 400 hatasını veriyor.
 
Hangi sayfadayken hata veriyor
herhalde Çalışma sayfasında hata alıyorsunuzdur.
 
formda aktif (online) görüküyorsunuz ama sorularıma çok geç cevap yazıyorsunuz.
 
son sayfanın adı ney
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst