A listesinde 2 şerli satır halindeki verileri B sayfasına Tek Satır haline Nasıl geti

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Aşağıdaki Resimde de görüleceği
Adı => Syfa1!A5 hücresine
Soyadı => Syfa1!A6 hücresine
yazılmış bunu
Sayfa2 ye
2. satırdan itibaren
Adı B Hücresine
Soyadı C hücresine nasıl yazabilirz?
 

Ekli dosyalar

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,607
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
Adı => Syfa1!A5 hücresine Soyadı => Syfa1!A6 hücresine
yazılmış bunu Sayfa2 ye
2. satırdan itibaren Adı B Hücresine Soyadı C hücresine nasıl yazabilirz?
Merhaba,
Örnek dosyanızı inceledim. Adı => Syfa1!E5 hücresine Soyadı => Syfa1!E6 hücresine yazılmış.
Sayfa2 ye
2. satırdan itibaren Adı F Hücresine Soyadı G hücresine yazılacakmış gibi görünüyor. Yani yukarıdaki ifadenizle çelişiyor.
Önce bunu düzeltelim. Sonrası kolay.
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Sn dede doğru anlamışsınız ben Asıl Listede Soyadı/Adı eşklindeki durumu son listede Ad/soyad şeklinde düzeltilmesini istiyorum mümkün değilse Soyadı Adı olarak yapalım
 

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,607
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
Sn dede doğru anlamışsınız ben Asıl Listede Soyadı/Adı eşklindeki durumu son listede Ad/soyad şeklinde düzeltilmesini istiyorum mümkün değilse Soyadı Adı olarak yapalım
Sayın hsayar, yine anlaşamadık galiba. Örnek dosyanızda Soyad/Adı şeklinde bir düzenleme yok.
Neyse ben örnek dosyanızdan yola çıkarak aşağıdaki kodları öneriyorum.
Bir deneyin yanlışlık varsa düzeltiriz.
Kolay gelsin.

Kod:
Sub aktar()
Set s1 = Sheets("bayrambey")
Set s3 = Sheets("Sayfa3")
s1.Select
  j = 2
For i = 5 To [E65536].End(3).Row
    If i Mod 2 Then
        s3.Cells(j, 6).Value = s1.Cells(i, 5).Value
        s3.Cells(j, 7).Value = s1.Cells(i + 1, 5).Value
        j = j - 1
    End If
    j = j + 1
Next i
s3.Select
End Sub
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
sn dede alakanıza teşekkür ederim.
Buna benzer bir şeydi toparladım.

Kod:
Sub aktar()
Set s1 = Sheets("bayrambey")
Set s3 = Sheets("snc")  'Sheets.Add
s1.Select
  j = 2
For i = 5 To [E65536].End(3).Row
    If i Mod 2 Then
        s3.Cells(j, 1).Value = s1.Cells(i, 1).Value
        s3.Cells(j, 2).Value = s1.Cells(i + 1, 1).Value
        s3.Cells(j, 3).Value = s1.Cells(i, 2).Value
        s3.Cells(j, 4).Value = s1.Cells(i, 3).Value
        s3.Cells(j, 5).Value = s1.Cells(i, 4).Value
        s3.Cells(j, 6).Value = s1.Cells(i, 5).Value
        s3.Cells(j, 7).Value = s1.Cells(i + 1, 5).Value
        s3.Cells(j, 8).Value = s1.Cells(i, 6).Value
        s3.Cells(j, 9).Value = s1.Cells(i + 1, 6).Value
        
        s3.Cells(j, 10).Value = s1.Cells(i, 7).Value
        s3.Cells(j, 11).Value = s1.Cells(i + 1, 7).Value
        s3.Cells(j, 12).Value = Format(s1.Cells(i, 8).Value, "dd.mm.yyyy")
        s3.Cells(j, 13).Value = s1.Cells(i + 1, 8).Value
        s3.Cells(j, 14).Value = s1.Cells(i, 9).Value
        s3.Cells(j, 15).Value = s1.Cells(i + 1, 9).Value
        j = j - 1
    End If
    j = j + 1
Next i
s3.Select
s3.Cells.EntireColumn.AutoFit
End Sub
 
Üst