Sayfa Birleştirme

[yilmaz1717]

Merhaba arkadaşlar,
Ekli dosyadaki sayfaları birleştirmek istiyorum.
formlarda örnekler buldum, lakin çözüm olmadı.
sayfalar formüllü 2 sayfayı 1 sayfada sıralı olarak
birleştirmek istiyorum.
Yardımlarınız için teşekkürler.

 

[yilmaz1717]

bu konuda yardımcı olurmusunuz.
makro ile nasıl çözerim.
teşekkürler

 

[yilmaz1717]

Bu konuda yardımcı olacak arkadaş yokmu?

 

[chngrcn]

Eki inceleyiniz.. Saygılar..

Sub sayfalarıbirleştir() ' coded by CİHANGİR...
On Error Resume Next

Set s1 = Sheets("ÜRÜNLER")
Set s2 = Sheets("ÜRÜN1")
Set s3 = Sheets("ÜRÜN2")

s1.Range [A2:DM65500].ClearContents

    sat = s1.[A65536].End(3).Row + 1
    
    Application.ScreenUpdating = False
        
        For i = 2 To s2.[A65536].End(3).Row
        
        s1.Cells(sat, 1).Value = s2.Cells(i, 1).Value
        s1.Cells(sat, 2).Value = s2.Cells(i, 2).Value
        s1.Cells(sat, 3).Value = s2.Cells(i, 3).Value
        s1.Cells(sat, 4).Value = s2.Cells(i, 4).Value
        s1.Cells(sat, 5).Value = s2.Cells(i, 5).Value
        s1.Cells(sat, 6).Value = s2.Cells(i, 6).Value
        
               
            sat = sat + 1
    Next i
    
    sat = sat - 1
    
            For y = 2 To s3.[A65536].End(3).Row
                
                s1.Cells(sat, 1).Value = s3.Cells(y, 1).Value
                s1.Cells(sat, 2).Value = s3.Cells(y, 2).Value
                s1.Cells(sat, 3).Value = s3.Cells(y, 3).Value
                s1.Cells(sat, 4).Value = s3.Cells(y, 4).Value
                s1.Cells(sat, 5).Value = s3.Cells(y, 5).Value
                s1.Cells(sat, 6).Value = s3.Cells(y, 6).Value
                
            sat = sat + 1
    Next y

MsgBox " Aktarım tamamlanmıştır...", , ""
    
    Application.ScreenUpdating = True


End Sub

 

[yilmaz1717]

çok teşekkürler elinize sağlık

 

[Necdet]

Merhaba,

Alternatif olsun

Sub Syf_Birlestir()
 
    Dim Syf As Worksheet
    Dim Sat As Long
    Dim i   As Long
    
    Sheets("ÜRÜNLER").Select
    Application.ScreenUpdating = False
    i = Cells(Rows.Count, "A").End(3).Row
    If i < 2 Then i = 2
    Range("A2:F" & i).ClearContents
    
    For Each Syf In Worksheets
        If Not Syf.Name = "ÜRÜNLER" Then
            If Syf.Name Like "ÜRÜN*" Then
                i = Syf.Cells(Rows.Count, "F").End(3).Row
                Sat = Sheets("ÜRÜNLER").Cells(Rows.Count, "A").End(3).Row + 1
                Syf.Range("A2:F" & i).Copy
                Sheets("ÜRÜNLER").Range("A" & Sat).PasteSpecial Paste:=xlPasteValues
            End If
        End If
    Next Syf
    
    i = Cells(Rows.Count, "A").End(3).Row
    Range("A2:F" & i).Sort Key1:=[A1]
    Range("G2").Activate
    
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
    
End Sub

 

[yilmaz1717]

Birleştirilecek sayfa isimleri ürün1+ürün2 değilde,
ekilen+hasat olsaydı sayfa isimleri makroyu nasıl düzenlerdik.
yardımlarınız için çok teşekkürler

 

[Necdet]

Merhaba,

Sayfa isimleri ekilen1, ekilen2 ... ya da hasat1, hasat2... olarak gidiyorsa eğer

If Syf.Name Like "ÜRÜN*" Then

satırını

If Syf.Name Like "hasılat*" Or Syf.Name Like "hasat*" Then

olarak kullanılması gerekir.

De yinede dosyadaki sayfaları görmekte yarar var.

 

[yilmaz1717]

Necdet bey teşekkürler.
elinize sağlık.