LİSTE

[osmanucel]

Ekte verdıgım dosyada acıkladım bakabılırsenız

 

[cems]

Keşke burda sorunu açıklasanız da dosya indirmeye gerek olmadan yapabilecek arkadaşların direk müdahalesi mümkün olsa ...

 

[osmanucel]

Sayfa 1 verilerin bulundugu syfa
burdakı a sutunundakı kosula gore
verileri sayfa 2 ye atmak
verilerde a sutununda sıra no var
verılen sıra noda olan tum bılgılerı sıralayıp sayfa ıkıye kopyalatmak ıstıyrum

 

[Husgvarna]

Merhaba.
"VERİLER" adlı sayfaya ekleyeceğiniz butona:

 Private Sub CommandButton1_Click()
Sheets("SAYFA").[a2:h65000] = Empty
For x = 4 To Cells(65000, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("a2:a" & x), Cells(x, 1)) = 1 Then
a = Sheets("SAYFA").Cells(65000, 1).End(xlUp).Row + 1
Range("A" & x & ":h" & x).Copy Sheets("SAYFA").Range("A" & a & ":h" & a)
Range("A" & x & ":h" & x).Interior.ColorIndex = 3
End If
Next
End Sub

 

[cems]

Ya da veriler sayfasına bir buton ekleyip şu kodları açılan modüle yükleyin:

Sub Makro2()

Sheets("SAYFA").Select
Range("a3:I20").ClearContents
Sheets("VERİLER").Select
Range("A3:I65").Select
Selection.Copy
Sheets("SAYFA").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("VERİLER").Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$3:$H$65533").AutoFilter Field:=1
Range("A1").Select
End Sub

Veriler sayfasındaki seçiminizi SAYFA sayfasına aktarıyor.

 

[osmanucel]

hocam bunların ıkısıde olmamıs
sayfayı ıncelemedınız sanırım

 

[osmanucel]

Verilerde a sutununda sayılar var
mesela 2 3satırda 2 yazılı
bensımdı sayfa da a sutunundamesela a5 e yazdıgım bı sayıyı
verılerden sayfaya aktaracak
3satırıda aktaracak
bu sekılde

 

[osmanucel]

Acıklamayı ben yanlıs yazmısım özur dılerım

 

[Husgvarna]

Verilerde a sutununda sayılar var
mesela 2 3satırda 2 yazılı
bensımdı sayfa da a sutunundamesela a5 e yazdıgım bı sayıyı
verılerden sayfaya aktaracak
3satırıda aktaracak
bu sekılde

Merhaba.
Şöyle olurmu? "A" sütununa veri girip çıktığınızda:

Private Sub Worksheet_Change(ByVal Target As Range)

'Sheets("SAYFA").[a2:h65000] = Empty 'SAYFA BOŞALTILACAKSA EN BAŞTAKİ TIRNAĞI KALDIRIN

If Target.Column <> 1 Then Exit Sub
s = WorksheetFunction.CountIf(Range("a2:a65000"), Target)
For x = 1 To s
Range("a2:a65000").Find(What:=Target, After:=ActiveCell, LookAt:=xlWhole).Activate
i = ActiveCell.Row
a = Sheets("SAYFA").Cells(65000, 1).End(xlUp).Row + 1
Range("A" & i & ":h" & i).Copy Sheets("SAYFA").Range("A" & a & ":h" & a)
Range("A" & i & ":h" & i).Interior.ColorIndex = 4
Next
End Sub

 

[osmanucel]

Arkadaslar allah razı olsun ılgılenıyorsunuzda benım sorum su
verılerdekı sayfada zaten verıler gırılmıs yada gırılecek
verılerdekı ıslemlerı
a sutununda
verılen sayılar var
1.2.3 satır a 2var yanı uc tane 2
ben sımdı
sayfaya
adı sayfa olan sayfanın
a sutununda
verdıgım
2 yada 3 yada 4 yazdıgımda
verılerdekı 2 olan satırlar
gelecek
sanırım
yanlıs anlasılıyorum

 

[kemal turan]

Merhaba,
Ek dosyaya bir bakın.
A1 hücresine istediğiniz s.no girip enter tuşuna basın sonucu görün.
Bu dosyadaki çalışma forumdaki ustadlarımzın emeğidir.
Ben sadece size uyarladm.
İnşaallah işinizi görür.
Selametle kalın.

 

[osmanucel]

Allah razı olsun cok sagolun

 

[kemal turan]

Sizden de razı olsun.
Bize bu yardımları yapmamıza vesile olan ustadlardan da .
Selametle kalın.

 

[osmanucel]

verılen kod ısdedıgımı yapıyo ama
verdıgım numaradan fazlasını alıyo acaba sadece yazdıgım noyu
aktarabılırmıyız

 

[kemal turan]

Sn.Osman kardeşim,
uzun süre uğraştım ama olmadı.
Filtreleme mantığında misal 2 yazdığınızda a sutununda içerisinde 2 yazan 2,12,22,32,42,52,62,72.... gibi bütün verilerin değerlerini çekiyor.
Bundan sonrası uzmanlarımızın işi.
Selametle kalın

 

[osmanucel]

Abı yanlıs anlama cok sagol farkındayım cunkı bende ugrasıyom aynı sekıl oluyo ılgın ıcın allah razı olsun yemınle gece ıkı ye kadar ugrasdım
olmuyo allah razı olsun cok sagol

 

[osmanucel]

Ben yaptım sonunda ya tam ısdedıgım gıbı oldu allah razı olsun ugrasın ıcın

 

[osmanucel]

Sub suz_aktar()
Dim sat As Long, sh As Worksheet
Sheets("VERİLER").Select
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set sh = Sheets("SAYFA")
sat = Cells(Rows.Count, "A").End(xlUp).Row
sh.Range("A2" & sh.Rows.Count).ClearContents
Range("A1").AutoFilter
Range("A1").AutoFilter field:=1, Criteria1:=sh.Range("I1").Value
If WorksheetFunction.Subtotal(103, Range("A1:A" & sat)) > 1 Then
Range("A1").CurrentRegion.Copy sh.Range("A1")
End If
Range("A1").AutoFilter
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
sh.Select
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub
ALLAH EVREN BEYDEN RAZI OLSUN