aynı tip altalta tabloları sekmelere gönderme

[modoste]

merhaba sayın hocalarım
ekli tablomda sorumu ilettim.

 

[Ziynettin]

Deneyiniz....

Sub test()
Application.ScreenUpdating = False
Application.DisplayAlerts = 0
    For Each sh In ThisWorkbook.Worksheets
        Select Case sh.Name
            Case "ana liste"
        Case Else
            sh.Delete
        End Select
    Next sh
Application.DisplayAlerts = 1
Set s1 = Sheets("ana liste")
    a = s1.Range("E3:H41").Value
    For i = 1 To UBound(a) Step 13
        y = y + 1
        Set s2 = Sheets.Add
        s2.Move after:=Sheets(Sheets.Count)
        s2.Name = y
        s2.[B3].Resize(13, 4) = s1.Range("E" & i + 2).Resize(13, 4).Value
    Next i
    s1.Select
Application.ScreenUpdating = True
End Sub

 

[modoste]

sayın ziynettin hocam kodu denedim tabloyu ayırarak sekmelere 1-2-3 adlarla ekledi
hücrelerin kenarlıklarının renklerinin biçimlerininde aynı olması gerekiyor.

ayrıca hocam kodun içindekileri ben sorduğum sekme içinde belirterek buldursam
parçalanacak tablonun tamamı = E3:H41
kaç satırda bir ayrılacağı = 13
kaç sütunda bir ayrılacağı = 4
böyle belirledikten sonra makro çalıştırılıp sekmelere atsa

bu sorumda bir çeşit tablo için olsa uygulamıştım ama birden fazla tablo var bu şekilde parçalamam gereken o yüzden bu detayları soruyorum

 

[modoste]

3 nolu mesajımdan sadece tablo kenarlıklarının ve biçimlerininde aynı makro ile sağlanması gerekiyo. bu çözümü yapabilir miyiz.