Herkese merhaba, ekte gönderdiğim dosyada makro ile birleştirilmiş bir tablo var.
Sadece ufak bi kısmını koydum örnek dosyaya.
Benim istediğim bu verilerin altalta değilde ayrı ayrı yatay olarak sıralanması.
Örnekte belirttim.
Bu veriyi oluşturan sayfa1 ve sayfa2 yi eklemedim, sadece birleştirilmiş sayfayı ekledim.
Daha önce bir arkadaş göndermişti bu makroyu bana.
Makroda aşağıda;
Sub birlestir()
Worksheets("TOPLAM").Rows("2:65000").ClearContents
sat = Worksheets("TOPLAM").Cells(Rows.Count, "A").End(3).Row + 1
For r = 1 To ActiveWorkbook.Sheets.Count
If Sheets(r).Name <> "TOPLAM" Then
For i = 2 To Worksheets(Sheets(r).Name).Cells(Rows.Count, "A").End(3).Row
Worksheets("TOPLAM").Cells(sat, 1).Value = Worksheets(Sheets(r).Name).Cells(i, 1).Value
Worksheets("TOPLAM").Cells(sat, 2).Value = Sheets(r).Name
For j = 2 To 14
Worksheets("TOPLAM").Cells(sat, j + 1).Value = Worksheets(Sheets(r).Name).Cells(i, j).Value
Next
sat = sat + 1
Next i
End If
Next r
Worksheets("TOPLAM").Range("A2:O" & sat).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
MsgBox "işlem tamam"
End Sub
Sadece ufak bi kısmını koydum örnek dosyaya.
Benim istediğim bu verilerin altalta değilde ayrı ayrı yatay olarak sıralanması.
Örnekte belirttim.
Bu veriyi oluşturan sayfa1 ve sayfa2 yi eklemedim, sadece birleştirilmiş sayfayı ekledim.
Daha önce bir arkadaş göndermişti bu makroyu bana.
Makroda aşağıda;
Sub birlestir()
Worksheets("TOPLAM").Rows("2:65000").ClearContents
sat = Worksheets("TOPLAM").Cells(Rows.Count, "A").End(3).Row + 1
For r = 1 To ActiveWorkbook.Sheets.Count
If Sheets(r).Name <> "TOPLAM" Then
For i = 2 To Worksheets(Sheets(r).Name).Cells(Rows.Count, "A").End(3).Row
Worksheets("TOPLAM").Cells(sat, 1).Value = Worksheets(Sheets(r).Name).Cells(i, 1).Value
Worksheets("TOPLAM").Cells(sat, 2).Value = Sheets(r).Name
For j = 2 To 14
Worksheets("TOPLAM").Cells(sat, j + 1).Value = Worksheets(Sheets(r).Name).Cells(i, j).Value
Next
sat = sat + 1
Next i
End If
Next r
Worksheets("TOPLAM").Range("A2:O" & sat).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
MsgBox "işlem tamam"
End Sub
