• DİKKAT

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

sayfadan veri kopyalama

T

tkcargo

Katılım
11 Haziran 2009
Mesajlar
64
Excel Vers. ve Dili
16 Türkçe
arkadaşlar merhaba
ekteki dosyada yapmak istediğim şu
1 2 3 4 5 6. sayfada q r ve s sutunlarında işlem yapınca o satırdaki c sutunundaki verileri tarayıp genel listede ilgili yere nasıl kopyalayabiliriz
ornek 1. sayfadaki 457 verisinde q sutununa veri yazdım hemen genel listede 457 yi bulacak ve ilgili satır sutuna kopyalayacak
teşekkurler

yada şoyle bir formulu guncelleyebilirmiyiz ve nasıl kullanırız


Dim X As Long, SATIR As Long

For X = 6 To [A65536].End(3).Row
If WorksheetFunction.CountIf([c9:c53], SHEETS("genel liste")Cells(X, "D")) > 0 Then
SATIR = Sheets("1").Range("D65536").End(3).Row
Sheets("genel liste").Range("q" & SATIR & ":s" & SATIR).Value = Range(Cells(X, "q"), Cells(X, "s")).Value
End If
End Sub
 

Ekli dosyalar

yada düşeyara formulu ile olurmu
genel listede q r s sutunlarına yapıstırsam bu 6 sayfada da arama yapabılırmı
 
tkcargo' Alıntı:
bi cozum varmı
Genişletmek için tıkla ...
"ThisWorkbook" kod sayfasına aşağıdaki kodları ekleyip; deneyin.

Kod: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name = "Genel Liste" Then Exit Sub
If Target.Column >= 17 And Target.Column <= 19 Then
Set a = Sheets("Genel Liste").[c9:c65000].Find(What:=Range("c" & Target.Row).Value, LookIn:=xlValues, LookAt:=xlPart)
If Not a Is Nothing Then
Sheets("Genel Liste").Range("f" & a.Row & ":s" & a.Row).Value = Range("f" & Target.Row & ":s" & Target.Row).Value
End If
End If
End Sub
 
Husgvarna' Alıntı:
"ThisWorkbook" kod sayfasına aşağıdaki kodları ekleyip; deneyin.

Kod: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name = "Genel Liste" Then Exit Sub
If Target.Column >= [COLOR="Red"]17[/COLOR] And Target.Column <= [COLOR="red"]19[/COLOR] Then
Set a = Sheets("Genel Liste").[c9:c65000].Find(What:=Range("c" & Target.Row).Value, LookIn:=xlValues, LookAt:=xlPart)
If Not a Is Nothing Then
Sheets("Genel Liste").Range("[COLOR="red"]f[/COLOR]" & a.Row & ":[COLOR="red"]s[/COLOR]" & a.Row).Value = Range("[COLOR="red"]f[/COLOR]" & Target.Row & ":[COLOR="red"]s[/COLOR]" & Target.Row).Value
End If
End If
End Sub
Genişletmek için tıkla ...

sayın husgvarna tesekkurler calısıyor peki veri kopyalama aralığını artırsak
kırmızı ile gosterilen yerleri degistirmek yetermi ornek q ile s aralıgını degilde f ile s aralıgını almak istediğimde birde aralıkta kilitli sutun varsa formul hata veriyor nasıl bır cozumu var
 
tkcargo' Alıntı:
sayın husgvarna tesekkurler calısıyor peki veri kopyalama aralığını artırsak
kırmızı ile gosterilen yerleri degistirmek yetermi ornek q ile s aralıgını degilde f ile s aralıgını almak istediğimde birde aralıkta kilitli sutun varsa formul hata veriyor nasıl bır cozumu var
Genişletmek için tıkla ...

Merhaba.
Kod: 
If Target.Column >= [COLOR="Red"]17[/COLOR] And Target.Column <= [COLOR="#ff0000"]19 [/COLOR]Then
"Genel Liste" dışında diğer sayfalarda 17. 18. 19. sütunlar haricinde diğer sütunlara veri girildiğinde makronun çalışmasını engeller.


Kod: 
Sheets("Genel Liste").Range([COLOR="#ff0000"]"f"[/COLOR] & a.Row & [COLOR="#ff0000"]":s"[/COLOR] & a.Row).Value = Range([COLOR="#ff0000"]"f"[/COLOR] & Target.Row & [COLOR="#ff0000"]":s"[/COLOR] & Target.Row).Value
Bu bölüm; örneğin "1" adlı sayfadaki Range("f9:s9") aralığını: Sheets("Genel Liste").Range("f9:s9") aralığına aktarmak içindir. Burada aktarılan hücre adedi
ile aktarılan yerin hücre adedi hata vermemesi için eşit olmalıdır.
Range("f9:s9") bölümleri yerine Range("e9:s9") yaparsanız kopyalama aralığı artar ama "Genel Liste" deki "E" sütununda ki formül bozulur.
Kilitli sütunlarda hata vermemesi gerek ancak Sayfa koruması varsa olabilir.
Koruma varsa kod eklenerek sorun çözülür.
 
sayın husgvarna,
ilginize tesekkurler dediginiz gibi uyguladım fakat formulde asagıdaki satır hata
veriyor
Set a = Sheets("Genel Liste").[c9:c65000].Find(What:=Range("c" & Target.Row).Value, LookIn:=xlValues, LookAt:=xlPart)

ekte dosyayı tekrar gonderiyorum sutunlar arttı icinde acıklama mevcut
 

Ekli dosyalar

sayın husgvarna,
birde bu calısma kitabında ornek oldugu icin burda yok genel liste ve 6 sayfa dısında
sayfalarda mevcut formulde goremedım onlardanda veri almasın yanlıslıkla
 
sn husgvarna kodu aşağıdaki gibi degistirdim istedigim satırları ekliyor fakat
kırmızı ile isretledigim satır hata veriyor neden kaynaklanabilir?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name = "Genel Liste" Then Exit Sub
If Target.Column >= 6 And Target.Column <= 22 Then
Set a = Sheets("Genel Liste").[c9:c1000].Find(What:=Range("c" & Target.Row).Value, LookIn:=xlValues, LookAt:=xlPart)
If Not a Is Nothing Then
Sheets("Genel Liste").Range("f" & a.Row & ":v" & a.Row).Value = Range("f" & Target.Row & ":v" & Target.Row).Value
End If
End If
End Sub
 
Aşağıdaki kodları ayrı ayrı denermisiniz.
1:kod
Kod: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name = "Genel Liste" Then Exit Sub
If Target.Column >= 6 And Target.Column <= 9 Then GoTo s
If Target.Column >= 12 And Target.Column <= 22 Then
s:
Set a = Sheets("Genel Liste").[c9:c65000].Find(What:=Range("c" & Target.Row), LookIn:=xlValues, LookAt:=xlPart)
Application.EnableEvents = False
If Not a Is Nothing Then
If Range("c" & Target.Row).Value <> "" Then
Sheets("Genel Liste").Cells(a.Row, Target.Column) = Target.Cells
End If
End If
End If
Application.EnableEvents = True
End Sub


2. kod
Kod: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name = "Genel Liste" Then Exit Sub
If Target.Column >= 6 And Target.Column <= 9 Then GoTo s
If Target.Column >= 12 And Target.Column <= 22 Then
s:
If Range("c" & Target.Row).Value = "" Then Exit Sub
For a = 9 To Sheets("Genel Liste").Cells(65000, 2).End(xlUp).Row
If Sheets("Genel Liste").Cells(a, 3).Value = Range("c" & Target.Row).Value Then
Sheets("Genel Liste").Cells(a, Target.Column).Value = Target.Cells.Value
Exit Sub
End If
Next
End If
End Subb
 
Husgvarna' Alıntı:
Aşağıdaki kodları ayrı ayrı denermisiniz.
1:kod
Kod: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name = "Genel Liste" Then Exit Sub
If Target.Column >= 6 And Target.Column <= 9 Then GoTo s
If Target.Column >= 12 And Target.Column <= 22 Then
s:
Set a = Sheets("Genel Liste").[c9:c65000].Find(What:=Range("c" & Target.Row), LookIn:=xlValues, LookAt:=xlPart)
Application.EnableEvents = False
If Not a Is Nothing Then
If Range("c" & Target.Row).Value <> "" Then
Sheets("Genel Liste").Cells(a.Row, Target.Column) = Target.Cells
End If
End If
End If
Application.EnableEvents = True
End Sub


2. kod
Kod: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name = "Genel Liste" Then Exit Sub
If Target.Column >= 6 And Target.Column <= 9 Then GoTo s
If Target.Column >= 12 And Target.Column <= 22 Then
s:
If Range("c" & Target.Row).Value = "" Then Exit Sub
For a = 9 To Sheets("Genel Liste").Cells(65000, 2).End(xlUp).Row
If Sheets("Genel Liste").Cells(a, 3).Value = Range("c" & Target.Row).Value Then
Sheets("Genel Liste").Cells(a, Target.Column).Value = Target.Cells.Value
Exit Sub
End If
Next
End If
End Subb
Genişletmek için tıkla ...

sayın husgvarna cok tesekkurler ilk formul isimi gordu gayet duzgun calısıyor emeginize saglık yalnız bisey soracam kitapta bu sayfalar haric baska sayfalar var ise bu formulle veri alırmı demek istedigim yanlıslıkla ilgisiz sayfalardan veri almasın
 
tkcargo' Alıntı:
sayın husgvarna cok tesekkurler ilk formul isimi gordu gayet duzgun calısıyor emeginize saglık yalnız bisey soracam kitapta bu sayfalar haric baska sayfalar var ise bu formulle veri alırmı demek istedigim yanlıslıkla ilgisiz sayfalardan veri almasın
Genişletmek için tıkla ...
Merhaba.

"Genel Liste" adlı sayfaya veri göndermesini istemediğiniz sayfa adlarını:
Kod: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
başlığının altına;
aşağıdaki kırmızı bölümün yerine; yazıp alt alta ekleyin.

Kod: 
If ActiveSheet.Name = "[COLOR="Red"]MSJ[/COLOR]" Then Exit Sub
 
cok tesekkurler
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst