Çoklu satır ve sütun tersine çevirme

[sesen1]

Öncelikle herkese iyi akşamlar diliyorum, içinden çıkamadığım bir konu hakkında yardımlarınızı rica ediyorum.Eklediğim dosyada istediğimi anlatmaya çalıştım sayfa1'de kayıtlı olan listeyi ki orjinalinde yaklaşık 2700 satır ve 22 sütundan oluşuyor bazı sütunlarda kayıt olmayabiliyor, sayfa2 'de oluşturduğum örnek liste formatına çevirmek istiyorum. İlgilenen arkadaşlara teşekkürler.

 

[halit3]

Öncelikle herkese iyi akşamlar diliyorum, içinden çıkamadığım bir konu hakkında yardımlarınızı rica ediyorum.Eklediğim dosyada istediğimi anlatmaya çalıştım sayfa1'de kayıtlı olan listeyi ki orjinalinde yaklaşık 2700 satır ve 22 sütundan oluşuyor bazı sütunlarda kayıt olmayabiliyor, sayfa2 'de oluşturduğum örnek liste formatına çevirmek istiyorum. İlgilenen arkadaşlara teşekkürler.

Makrolu çözümü var ama bu kodu nasıl kullanacağınızı bilmeniz gerekiyor

kod

Sub aktar()
Sheets("Sayfa2").Range("A2:F" & Rows.Count).ClearContents
sat = 2
For i = 2 To Worksheets("Sayfa1").Cells(Rows.Count, "B").End(3).Row
aranan1 = Sheets("Sayfa1").Cells(i, 1).Value
aranan2 = Sheets("Sayfa1").Cells(i, 2).Value
aranan3 = Sheets("Sayfa1").Cells(i, 3).Value
aranan4 = Sheets("Sayfa1").Cells(i, 4).Value
Sheets("Sayfa2").Cells(sat, 1).Value = aranan1
Sheets("Sayfa2").Cells(sat, 2).Value = aranan2
Sheets("Sayfa2").Cells(sat, 3).Value = aranan3
Sheets("Sayfa2").Cells(sat, 4).Value = aranan4
Sheets("Sayfa2").Cells(sat, 5).Value = Sheets("Sayfa1").Cells(i, 5).Value
Sheets("Sayfa2").Cells(sat, 6).Value = ""
sat = sat + 1
Sheets("Sayfa2").Cells(sat, 1).Value = aranan1
Sheets("Sayfa2").Cells(sat, 2).Value = aranan2
Sheets("Sayfa2").Cells(sat, 3).Value = aranan3
Sheets("Sayfa2").Cells(sat, 4).Value = Sheets("Sayfa1").Cells(i, 6).Value
Sheets("Sayfa2").Cells(sat, 5).Value = Sheets("Sayfa1").Cells(i, 7).Value
Sheets("Sayfa2").Cells(sat, 6).Value = aranan4
sat = sat + 1
Sheets("Sayfa2").Cells(sat, 1).Value = aranan1
Sheets("Sayfa2").Cells(sat, 2).Value = aranan2
Sheets("Sayfa2").Cells(sat, 3).Value = aranan3
Sheets("Sayfa2").Cells(sat, 4).Value = Sheets("Sayfa1").Cells(i, 8).Value
Sheets("Sayfa2").Cells(sat, 5).Value = Sheets("Sayfa1").Cells(i, 9).Value
Sheets("Sayfa2").Cells(sat, 6).Value = aranan4
sat = sat + 1
Sheets("Sayfa2").Cells(sat, 1).Value = aranan1
Sheets("Sayfa2").Cells(sat, 2).Value = aranan2
Sheets("Sayfa2").Cells(sat, 3).Value = aranan3
Sheets("Sayfa2").Cells(sat, 4).Value = Sheets("Sayfa1").Cells(i, 10).Value
Sheets("Sayfa2").Cells(sat, 5).Value = Sheets("Sayfa1").Cells(i, 11).Value
Sheets("Sayfa2").Cells(sat, 6).Value = aranan4
sat = sat + 1
Next i
MsgBox "işlem tamam"
End Sub

 

[sesen1]

Halit Bey merhaba öncelikle ilginize teşekkür ederim. Göndermiş olduğunuz kodu yapıştırdım ve elinize sağlık gayet güzel çalıştı, mantığını çözmeye çalıştım ancakkod yazmakgibi bir becerim maalesef yok. Şunu öğrenmek istiyorum anladığım kadarıyla satır sayısı bir şeyi etkilemiyor ancak sütun sayısı "AJ" sütununa kadar bu durumda koda yapmam gereken ilave nedir bilgi verebilirseniz sevinirim.
Emeğiniz için tekrar teşekkür ederim.

 

[halit3]

Halit Bey merhaba öncelikle ilginize teşekkür ederim. Göndermiş olduğunuz kodu yapıştırdım ve elinize sağlık gayet güzel çalıştı, mantığını çözmeye çalıştım ancakkod yazmakgibi bir becerim maalesef yok. Şunu öğrenmek istiyorum anladığım kadarıyla satır sayısı bir şeyi etkilemiyor ancak sütun sayısı "AJ" sütununa kadar bu durumda koda yapmam gereken ilave nedir bilgi verebilirseniz sevinirim.
Emeğiniz için tekrar teşekkür ederim.

Sutün sayısını kendisi belirliyor.

kod:

Sub aktar()
Sheets("Sayfa2").Range("A2:F" & Rows.Count).ClearContents
sut = Sheets("Sayfa1").Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
sat = 2
For i = 2 To Worksheets("Sayfa1").Cells(Rows.Count, "B").End(3).Row
aranan1 = Sheets("Sayfa1").Cells(i, 1).Value
aranan2 = Sheets("Sayfa1").Cells(i, 2).Value
aranan3 = Sheets("Sayfa1").Cells(i, 3).Value
aranan4 = Sheets("Sayfa1").Cells(i, 4).Value
Sheets("Sayfa2").Cells(sat, 1).Value = aranan1
Sheets("Sayfa2").Cells(sat, 2).Value = aranan2
Sheets("Sayfa2").Cells(sat, 3).Value = aranan3
Sheets("Sayfa2").Cells(sat, 4).Value = aranan4
Sheets("Sayfa2").Cells(sat, 5).Value = Sheets("Sayfa1").Cells(i, 5).Value
Sheets("Sayfa2").Cells(sat, 6).Value = ""
sat = sat + 1
If sut >= 6 Then
For j = 6 To sut Step 2
Sheets("Sayfa2").Cells(sat, 1).Value = aranan1
Sheets("Sayfa2").Cells(sat, 2).Value = aranan2
Sheets("Sayfa2").Cells(sat, 3).Value = aranan3
Sheets("Sayfa2").Cells(sat, 4).Value = Sheets("Sayfa1").Cells(i, j).Value
Sheets("Sayfa2").Cells(sat, 5).Value = Sheets("Sayfa1").Cells(i, j + 1).Value
Sheets("Sayfa2").Cells(sat, 6).Value = aranan4
sat = sat + 1
Next j
End If
Next i
MsgBox "işlem tamam"
End Sub

 

[sesen1]

Halit Bey çok teşekkür ederim emeğinize sağlık.