Hücre Seç ve Aktar

X

xlsx

Misafir
Sn Halit3
Birden fazla aktarma seçeneği içersinde 2.aktarılan kelimeye göre renkli yap aktar formüller hariç seçeneği ile istediğim işlemi ve fazlasını yapabildim elinize sağlık.Tşk:)
 
Katılım
18 Temmuz 2008
Mesajlar
27
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
26-07-2024
Emeklerinize Sağlık Gayet Güzel Çalışmalar Ortaya Çıkıyor.Seç ve Aktara benzer bir çalışma daha ekledim, Umarım Çok Kişininde işine Yaracayaktır. İlgilenirseniz Sevinirim. Saygılarımla.
 

Ekli dosyalar

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,873
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
bununla ilgili örnek var zaten
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,873
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
kelime değil değilmi yanlızca hücrenin tamamını kapsayacak
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,873
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
ekli dosyanızı kontrol ediniz,
 
Katılım
18 Temmuz 2008
Mesajlar
27
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
26-07-2024
Halit bey merhaba Öncelikle ilginiz için teşekkürler. Benim Anlatmak istediğim Bu Değildi, Yine Örnek ile Ekli Dosyada Anlatmaya Çalıştım. Saygılarımla.
 

Ekli dosyalar

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,873
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
dosya açağıda
 
Son düzenleme:
X

xlsx

Misafir
Halit3 çalışmanız daha önce hazır mıydı yoksa sonradan mı yaptınız bilemiyorum ama elinize sağlık, çok işimize yarayacak.Tşk
 
Katılım
18 Temmuz 2008
Mesajlar
27
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
26-07-2024
Herkese Tekrar Merhabalar,
Hücre aktar ile ilgili farklı bir çalışma istiyorum.
Örnek anlatımı ile ekli Dosyadır. Şimdiden Kolay Gelsin.
 

Ekli dosyalar

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,873
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
aradığınız bu kodmu

Sub aktar()
Dim s As Integer
Dim t As String
a = MsgBox("İşlemi aktarmak İstiyormusunuz..?", vbYesNo, C & " Hücresi")
If a = vbNo Then
Exit Sub
End If
sat = WorksheetFunction.CountA(Worksheets("Sayfa2").Range ("A2:A65000")) + 2
sutun_sayısı = 6
For j = 1 To sutun_sayısı
t = Columns(j).Address(0, 0)
m = Left(t, InStr(t, ":") - 1)
For i = 1 To WorksheetFunction.CountA(Worksheets("Sayfa1").Range (m & "1:" & m & "65000")) + 1
Worksheets("Sayfa2").Cells(sat, i + 1).Value = Worksheets("Sayfa1").Cells(i, 2)
Worksheets("Sayfa2").Cells(sat, i + 7).Value = Worksheets("Sayfa1").Cells(i, 3)
Worksheets("Sayfa2").Cells(sat, i + 13).Value = Worksheets("Sayfa1").Cells(i, 4)
Next i
Next j
Worksheets("Sayfa2").Cells(sat, 1).Value = sat - 1
End Sub
 
Son düzenleme:
Katılım
18 Temmuz 2008
Mesajlar
27
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
26-07-2024
Bu Kodlar çalışmadı. Örnek Dosya ile gönderebilirmisiniz.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,873
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
sistem bazı formüllerin arasını açıyor

sat = WorksheetFunction.CountA(Worksheets("Sayfa2").Rang e("A2:A65000")) + 2
For i = 1 To WorksheetFunction.CountA(Worksheets("Sayfa1").Rang e(m & "1:" & m & "65000")) + 1

bu kodlar muhtemelen kırmızı olmuştur

Rang e yazan yerlerin arası açık yapmış sistem sen bunların arasındaki boşluğu al yanı kapat

aşağıdaki gibi yap
Range
 
Katılım
18 Temmuz 2008
Mesajlar
27
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
26-07-2024
Evet dediğiniz şekilde yaptım açlıştı Aktarıyor ama Yazılanları silmesi gerek. Önceki Hüceryi temizliyordu şimdi yazılanlar aynı kalıyor.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,873
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
makronun ilk başına yanı
Sub aktar() bunun hemen altına

aşağıdaki kodu koy


Worksheets("Sayfa2").Range("A2:S500").ClearContents
 
Üst