Farklı Tabloları birleştirme

[hidayet1]

İki farklı sayfadaki verileri birleştirmek için yardımcı olurmusunuz.

 

[hidayet1]

Arkadaşlar çok acil yardıma ihtiyacım var!....

 

[hidayet1]

Hiç kimse yardımcı olmayacakmı??

 

[Korhan Ayhan]

Selamlar,

Dosyanızda Sheet2 de bulunan sütunlar sabitmidir yoksa azalıp artabilir mi?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub ÖZET_RAPOR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Satır As Long, Y As Integer, Sütun As Byte
    Dim BUL As Range, SAY As Integer
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    
    S1.Columns(256).Clear
    S2.Range("A2:R65536").Clear
    
    Satır = 2
    Sütun = 6
    
    S1.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=S1.Range("IV1"), Unique:=True
    For X = 2 To S1.Range("IV65536").End(3).Row
        S2.Cells(Satır, 1) = S1.Cells(X, 256)
        S2.Cells(Satır, 1).HorizontalAlignment = xlCenter
        
        Set BUL = S1.Columns(1).Find(S1.Cells(X, 256), LookAt:=xlWhole)
        If Not BUL Is Nothing Then
            SAY = WorksheetFunction.CountIf(S1.Range("A:A"), S2.Cells(Satır, 1))
            S2.Cells(Satır, 2) = BUL.Offset(0, 3)
            S2.Cells(Satır, 3) = "İSKONTO"
            S2.Cells(Satır + 1, 3) = "TL"
            S2.Cells(Satır + 2, 3) = "USD"
            S2.Cells(Satır + 3, 3) = "KONTÖR"
                    
            S2.Cells(Satır, 4) = Evaluate("=SUMIF(" & S1.Name & "!A:A," & S2.Cells(Satır, 1) & "," & S1.Name & "!K:K" & ")")
            S2.Cells(Satır, 4).NumberFormat = "#,##0.00 TL"
            
            For Y = BUL.Row To SAY + BUL.Row - 1
                S2.Cells(Satır, Sütun) = S1.Cells(Y, "K")
                S2.Cells(Satır, Sütun).NumberFormat = "#,##0.00 TL"
                S2.Cells(Satır, Sütun + 1) = S1.Cells(Y, "L")
                S2.Cells(Satır, Sütun + 1).NumberFormat = "m/d/yyyy"
                S2.Cells(Satır, Sütun + 1).HorizontalAlignment = xlCenter
                Sütun = Sütun + 2
            Next
            
            S2.Cells(Satır, 18) = S2.Cells(Satır, 6) + S2.Cells(Satır, 8) + S2.Cells(Satır, 10) + S2.Cells(Satır, 12) + S2.Cells(Satır, 14) + S2.Cells(Satır, 16)
            S2.Cells(Satır, 18).NumberFormat = "#,##0.00 TL"
            
            
            Sütun = 6
            S2.Cells(Satır + 1, 4) = Evaluate("=SUMIF(" & S1.Name & "!A:A," & S2.Cells(Satır, 1) & "," & S1.Name & "!G:G" & ")")
            S2.Cells(Satır + 1, 4).NumberFormat = "#,##0.00 TL"
            
            For Y = BUL.Row To SAY + BUL.Row - 1
                S2.Cells(Satır + 1, Sütun) = S1.Cells(Y, "G")
                S2.Cells(Satır + 1, Sütun).NumberFormat = "#,##0.00 TL"
                S2.Cells(Satır + 1, Sütun + 1) = S1.Cells(Y, "H")
                S2.Cells(Satır + 1, Sütun + 1).NumberFormat = "m/d/yyyy"
                S2.Cells(Satır + 1, Sütun + 1).HorizontalAlignment = xlCenter
                Sütun = Sütun + 2
            Next
            
            S2.Cells(Satır + 1, 18) = S2.Cells(Satır + 1, 6) + S2.Cells(Satır + 1, 8) + S2.Cells(Satır + 1, 10) + S2.Cells(Satır + 1, 12) + S2.Cells(Satır + 1, 14) + S2.Cells(Satır + 1, 16)
            S2.Cells(Satır + 1, 18).NumberFormat = "#,##0.00 TL"
            
            
            Sütun = 6
            S2.Cells(Satır + 2, 4) = Evaluate("=SUMIF(" & S1.Name & "!A:A," & S2.Cells(Satır, 1) & "," & S1.Name & "!E:E" & ")")
            S2.Cells(Satır + 2, 4).NumberFormat = "#,##0.00  \$ "
            
            For Y = BUL.Row To SAY + BUL.Row - 1
                S2.Cells(Satır + 2, Sütun) = S1.Cells(Y, "E")
                S2.Cells(Satır + 2, Sütun).NumberFormat = "#,##0.00  \$ "
                S2.Cells(Satır + 2, Sütun + 1) = S1.Cells(Y, "F")
                S2.Cells(Satır + 2, Sütun + 1).NumberFormat = "m/d/yyyy"
                S2.Cells(Satır + 2, Sütun + 1).HorizontalAlignment = xlCenter
                Sütun = Sütun + 2
            Next
            
            S2.Cells(Satır + 2, 18) = S2.Cells(Satır + 2, 6) + S2.Cells(Satır + 2, 8) + S2.Cells(Satır + 2, 10) + S2.Cells(Satır + 2, 12) + S2.Cells(Satır + 2, 14) + S2.Cells(Satır + 1, 16)
            S2.Cells(Satır + 2, 18).NumberFormat = "#,##0.00  \$ "
            
            
            Sütun = 6
            S2.Cells(Satır + 3, 5) = Evaluate("=SUMIF(" & S1.Name & "!A:A," & S2.Cells(Satır, 1) & "," & S1.Name & "!I:I" & ")")
            S2.Cells(Satır + 3, 5).NumberFormat = "#,##0.00"
            
            For Y = BUL.Row To SAY + BUL.Row - 1
                S2.Cells(Satır + 3, Sütun) = S1.Cells(Y, "I")
                S2.Cells(Satır + 3, Sütun).NumberFormat = "#,##0.00 TL"
                S2.Cells(Satır + 3, Sütun + 1) = S1.Cells(Y, "J")
                S2.Cells(Satır + 3, Sütun + 1).NumberFormat = "m/d/yyyy"
                S2.Cells(Satır + 3, Sütun + 1).HorizontalAlignment = xlCenter
                Sütun = Sütun + 2
            Next
        
            S2.Cells(Satır + 3, 18) = S2.Cells(Satır + 3, 6) + S2.Cells(Satır + 3, 8) + S2.Cells(Satır + 3, 10) + S2.Cells(Satır + 3, 12) + S2.Cells(Satır + 3, 14) + S2.Cells(Satır + 3, 16)
            S2.Cells(Satır + 3, 18).NumberFormat = "#,##0.00 TL"
        
        End If
        
        Satır = Satır + 4
    
    Next
        
    S2.Range("A1:R" & S2.Cells(65536, 3).End(3).Row).Borders.LineStyle = 1
    S2.Cells.EntireColumn.AutoFit
    
    S2.Select
    
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
        
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[hidayet1]

Teşekkür Ederim yardımınız için