Soru Alt Alta birleştirme

[seringel]

Herkese merhabalar,

Ekteki örnekte olduğu gibi 2 sekmede bulunan tüm satırları 3. sekmede alt alta nasıl birleştirebilriz.
Gerçek yapmak istediğim listeler 2000 satırları buluyor...

Yardımlarınızı rica ederim.

 

[mahmyt]

sayın seringel kodlar bu şekilde mi olacak çünkü 2 sayfada da aynı olan kodlar var

 

[seringel]

Evet aynı olan kodlar da var, aynı olan kodlar olduğunda alt alta sıralanabilir.

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kod ile yapabilirsiniz.

Sub Test()
    With Worksheets("Sayfa4")
        Worksheets("Sayfa1").Range("B:E").Copy .Range("B1")
        Worksheets("Sayfa2").Range("B2:E" & Worksheets("Sayfa2").Cells(Rows.Count, "B").End(xlUp).Row).Copy .Range("B" & .Cells(Rows.Count, "B").End(xlUp).Row + 1)
    End With
End Sub

 

[seringel]

Muzaffer bey teşekkür ederim ancak aynı kodlar alt alta gelmiyorlar
alt alta gelecek şekilde nasıl yapabiliriz...

 

[AdemCan]

Merhaba alternatif döngü örneği.

Sub test()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Dim s3 As Worksheet
Dim s3s As Long, i As Byte, s As Long

Set s3 = Sayfa3

s3s = s3.Cells(Rows.Count, 2).End(3).Row
s3.Range("B2:E" & s3s + 1).Clear

For i = 1 To Sheets.Count - 1
    s3s = s3.Cells(Rows.Count, 2).End(3).Row + 1
    s = Sheets(i).Cells(Rows.Count, 2).End(3).Row
    Sheets(i).Range("B2:E" & s).Copy s3.Range("B" & s3s)
Next i

s3s = s3.Cells(Rows.Count, 2).End(3).Row
With s3.Sort
    .SortFields.Add2 Key:=Range("B2:B" & s3s), Order:=xlAscending
    .SetRange Range("B1:E" & s3s)
    .Header = xlYes
    .Apply
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

 

[Muzaffer Ali]

Sub Test()
    With Worksheets("Sayfa4")
        Worksheets("Sayfa1").Range("B:E").Copy .Range("B1")
        Worksheets("Sayfa2").Range("B2:E" & Worksheets("Sayfa2").Cells(Rows.Count, "B").End(xlUp).Row).Copy .Range("B" & .Cells(Rows.Count, "B").End(xlUp).Row + 1)
        .Sort.SortFields.Add2 Key:=.Range("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
        .Sort.SetRange Range("B2:E" & Rows.Count)
        .Sort.Apply
    End With
End Sub

 

[Necdet]

Merhaba,
Aşağıdaki şekilde deneyebilirsiniz.

Sub Test()
    With Worksheets("Sayfa4")
        Worksheets("Sayfa1").Range("B:E").Copy .Range("B1")
        Worksheets("Sayfa2").Range("B2:E" & Worksheets("Sayfa2").Cells(Rows.Count, "B").End(xlUp).Row).Copy .Range("B" & .Cells(Rows.Count, "B").End(xlUp).Row + 1)
        .Range("B1").CurrentRegion.Offset(1).Sort Key1:=[B1]
    End With
End Sub

 

[Necdet]

Ben yanıt verene kadar bir sürü yanıt olmuş

 

[Haluk]

    strSQL = " Select * From [Sayfa1$B1:E] Union All Select * From [Sayfa2$B1:E] Order By [Kod]"

.