Telefonszámunk: 1-472-0679

Hozzászólás: [Resolved] Két táblázat adatainak beillesztése és táblázat átméretezése

Kezdőlap Fórumok Excel programozás [Resolved] Két táblázat adatainak beillesztése és táblázat átméretezése Hozzászólás: [Resolved] Két táblázat adatainak beillesztése és táblázat átméretezése

#10534
Adri0324
Felhasználó

    Sziasztok.
    Megoldottam. Bár 3 napom ráment. Ide teszem a kész kódot, ha valakit érdekel. Csatolom az Excelt is…
    Köszönöm a segítséget.

    Sub Masolas()
        Dim Munka2 As Worksheet
        Dim Munka1 As Worksheet
        Dim Szint2 As ListObject
        Dim Szint1 As ListObject
        Dim Tbl12 As ListObject
        Dim FirstRowTbl12 As Long
        Dim LastRowTbl12 As Long
        Dim osszegSor As Long
        
        Set Munka2 = ThisWorkbook.Sheets("Munka2")
        Set Szint2 = Munka2.ListObjects("Szint_2")
        
        Set Munka1 = ThisWorkbook.Sheets("Munka1")
        Set Szint1 = Munka1.ListObjects("Szint_1")
        
        Set Feladat = ThisWorkbook.Sheets("Feladat")
        Set Tbl12 = Feladat.ListObjects("Táblázat12")
        
         Feladat.ListObjects("Táblázat12").ShowTotals = False
        
        For i = Tbl12.ListRows.Count To 2 Step -1
            Tbl12.ListRows(i).Delete
        Next i
        Szint2.ListColumns("Érték ID").DataBodyRange.Value = Szint2.ListColumns("Ssz").DataBodyRange.Value
        Szint1.ListColumns("Érték ID").DataBodyRange.Value = Szint1.ListColumns("Ssz").DataBodyRange.Value
    
        FirstRowTbl12 = 1
        Tbl12.ListColumns("Érték ID").DataBodyRange.ClearContents
        
        Tbl12.ListColumns("Érték ID").DataBodyRange.Cells(FirstRowTbl12, 1).Resize(Szint1.ListColumns("Érték ID").DataBodyRange.Rows.Count, 1).Value = Szint1.ListColumns("Érték ID").DataBodyRange.Value
        
        LastRowTbl12 = FirstRowTbl12 + Szint1.ListColumns("Érték ID").DataBodyRange.Rows.Count
        Tbl12.ListColumns("Érték ID").DataBodyRange.Cells(LastRowTbl12, 1).Resize(Szint2.ListColumns("Érték ID").DataBodyRange.Rows.Count, 1).Value = Szint2.ListColumns("Érték ID").DataBodyRange.Value
        
        LastRowTbl12 = Tbl12.ListRows.Count
        Set ertekIDOszlop = Tbl12.ListColumns("Érték ID")
        LastRowTbl1 = Szint1.ListRows.Count
        LastRowTbl2 = Szint2.ListRows.Count
        
        osszegSor = Application.WorksheetFunction.Max(Szint1.ListRows(LastRowTbl1).Range, Szint2.ListRows(LastRowTbl2).Range)
        
        Tbl12.Resize Tbl12.HeaderRowRange.Resize(osszegSor + 1)
         
         Feladat.ListObjects("Táblázat12").ShowTotals = True
           
    End Sub
    Attachments:
    You must be logged in to view attached files.