Sayfalar arası veri transferi

[Mx@Raid]

Sub Kopyala()
'boş hücre sil
Rows("2:43").Select
Selection.Delete Shift:=xlUp

Range( _
"D3,D5,D7,D9,D11,D13,D15,D17,D19,D21,D23,D25,D27,D29,D31,D33,D35,D37,D39,D41,D43,D45,D47,D49,D51,D53,D55,D57" _
).Select
Selection.Copy
Sheets("SOYAD").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Application.CutCopyMode = False
Range( _
"3:3,5:5,7:7,9:9,11:11,13:13,15:15,17:17,19:19,21:21,23:23,25:25,27:27,29:29,31:31,33:33,35:35,37:37,39:39,41:41,43:43,45:45,47:47,49:49,51:51,53:53,55:55,57:57" _
).Select
Selection.Delete Shift:=xlUp
Sheets("SOYAD").Select
Selection.Cut
Sheets("Sheet1").Select
Range("E2").Select
ActiveSheet.Paste
'taşıma işlemi
Range("D2:E29").Select
Selection.Cut
Sheets("BİLGİLER").Select
Range("A2568").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("A2:C29").Select
Selection.Cut
Sheets("BİLGİLER").Select
Range("D2568").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End Sub

oluşturduğum makro bu arkadaşlar yalnız benim sıkıntım Range("2568").Select yazan değerleri sürekli olarak işlemi yaptıktan sonra değiştirmek zorunda olmam.

Bunun yerine nasıl bir makro ayarlmalıyım ki belirttiğim satırdaki değer oluşan boşluğa göre atama yapsın.

Mevcut dosyadaki verileri aslında tek tıkta yapmayı düşünüyordum isimlerin ve soy isimlerin adresleri dışındaki bilgileri silip sadece bunları olup tanımladığım hale getirebilsin düşüncesindeydim şimdilik bu da işimi görüyor.
Örnek dosya ektedir. Dosya daha büyük boyutta yalnız biraz küçülttüm.
Bilgilendiririseniz sevinirim.

 

[Mx@Raid]

Diğer bir nokta yukarıda verilen
Range( _
"D3,D5,D7,D9,D11,D13,D15,D17,D19,D21,D23,D25,D27,D 29,D31,D33,D35,D37,D39,D41,D43,D45,D47,D49,D51,D53 ,D55,D57" _
).Select yerine daha fazla verinin yeraldığı dosyada d3 den başlayıp d35000 aralığını tek tek yazmak yerine nasıl bir formül uygularız
Range( _
"3:3,5:5,7:7,9:9,11:11,13:13,15:15,17:17,19:19,21: 21,23:23,25:25,27:27,29:29,31:31,33:33,35:35,37:37 ,39:39,41:41,43:43,45:45,47:47,49:49,51:51,53:53,5 5:55,57:57" _
).Select hakeza buradada

diğer taraftan herhangi bir hücrede yer alan hücre içeriğinde adı, soyadı v.b yazan hücreleri otomatik bulup silmesini nasıl sağlayabiliriz. Dosyanın içeriğine bakacak olursanız orada isim soyad, adres, kapı numarasının dışında kaln hücreler var ve bunlar benim işime yaramayacak bunları silmem lazım örneğin "Cadde, Sokak Veya Kümenin Adı" olan hücreleri bulup çıkaracak.

 

[halit3]

dosyana baktım ne yapmak istediğini anlatırsan daha kısa bir kodla yardımcı olmaya çalışıyım

 

[Mx@Raid]

Sheets sayfasında üzerinde işlem yapmam gereken veriler var.
SOYAD sayfası kişilerin soyadlarının Sheets den alınıp daha sonra oluşan satır boşlukları silindikten sonra isimlerin yanına Sheets sayfasına aktarılıyor. bu düzenleme sağlandıktan sonra oluşan adres, kapı numarası ve ad, soyadlar BİLGİLER sayfasına gönderiliyor.

Aslında size gönderdiğim dosya elimdeki dosyanın minicik bir parcası. yaklaşık 35-40 bin kişi var dosyada. Ben her seferinde makroda incelediyseniz eğer Range("A2568").Select alnında hücre değerini belirtmek zorunda kalıyorum.

Diğer bir konu ise;
Range( _
"D3,D5,D7,D9,D11,D13,D15,D17,D19,D21,D23,D25,D 27,D 29,D31,D33,D35,D37,D39,D41,D43,D45,D47,D49,D51,D53 ,D55,D57" _
).Select
Range( _
"3:3,5:5,7:7,9:9,11:11,13:13,15:15,17:17,19:19 ,21: 21,23:23,25:25,27:27,29:29,31:31,33:33,35:35,37:37 ,39:39,41:41,43:43,45:45,47:47,49:49,51:51,53:53,5 5:55,57:57" _
).Select
makrolarının her hücrenin tek tek belirtilmesi yerine
Örneğin: Range(Başlangıç hücre değeri, (1 satır atlamasını sağlaycak ve belirtilecek son satıra kadar seçme işlemini sağlayan formül), Bitiş hücre değeri)
şeklinde bir yöntem oluşturabilmek hakeza bu 3:3,...den 57:57 ye kadar tanımladığım yer içinde uygulanması lazım.
Umarıım açıklayıcı olmuştur.

 

[halit3]

buradaki amaç sheet1 sayfasından sayadların adların altında kalması değilmi siz bu soyadları adların yanınamı almak istiyorsunuz.

 

[Mx@Raid]

Butonu Kullandınız mı bilmiyorum; sonrasında BİLGİLER sayfasına incelediniz mi?
Sheets1 verilerin olduğu kısım, bu veriler üzerinde düzenleme yapıp BİLGİLER sayfasına aktarılmasını sağlıyorum.
Benim temel sıkıntım yukarıda ifade ettiğim gibi tek tek hücrelerin yerlerine belirtmek yerine bir formül yoluyla bunu çözmek ki elimde 35 - 40 bin kişi var ve düşünün 28 kişi düzenedikten sonra tekrar hücre numaralarını yeniden yaz, yeniden butona komut ver.
tek bir defa da bütün verileri Sheets den alıp düzenlesin BİLGİLER sayfasına aktarsın

Eğer Sayfada neler yaptığını uygulayarak görürseniz net anlaşılır herhalde e yapmak istediğim.
Önce satır 90 kadar bir bakın Sheets de Sonra Düğme 1 e tıklayın BİLGİLER sayfasına geçin olayın ne olduğunu anlayacaksınız.

 

[halit3]

bu kodu denermisiniz,

Sub aktar()
sat = WorksheetFunction.CountA(Worksheets("BİLGİLER").Range("A1:A65000")) + 1
For i = 2 To 5000
If IsNumeric(Worksheets("Sheet1").Cells(i, 2).Value) = True Then
If Worksheets("Sheet1").Cells(i, 2).Value > 0 Then
Worksheets("BİLGİLER").Cells(sat, 2).Value = Worksheets("Sheet1").Cells(i + 1, 4).Value
Worksheets("BİLGİLER").Cells(sat, 1).Value = Worksheets("Sheet1").Cells(i, 4).Value
Worksheets("BİLGİLER").Cells(sat, 4).Value = Worksheets("Sheet1").Cells(i, 1).Value
Worksheets("BİLGİLER").Cells(sat, 5).Value = Worksheets("Sheet1").Cells(i, 2).Value
Worksheets("BİLGİLER").Cells(sat, 6).Value = Worksheets("Sheet1").Cells(i, 3).Value
sat = sat + 1
End If
End If
Next i
End Sub

 

[Mx@Raid]

Anlaşılabilir olması açısından uygulamanın nasıl yürüdüğüne dair dosya ekledim incelerseniz.

 

[Mx@Raid]

Halit3 Kardeş çok teşekkür ederim beni çok büyük bir dertten kurtardın. İnanılmazsın(ız) hepinizin emeği ve yardımları için teşekkür ederim.

 

[halit3]

iyi günler hayırlı işler