1

同じワークブック内の他の複数のシートからマスター シートを作成しようとしています。情報は表形式でフォーマットされており、マスター シートでもそのままにしておく必要があります。マスターおよびその他のタブはすべて、テンプレート シートに基づいています。マスター シートを正常に作成できますが、テーブルの書式設定により、コピーしたタブのフォントの色が上書きされます。以下は私のコードです。テーブルを保持しながら、フォントの色をマスターシートに正常にコピーすることについて何か考えはありますか?

Sub Combine()
    Dim i As Integer
    Dim j As Integer
    Dim ws1 As Worksheet
    'Adding multiple String variables for 5 accounts
    Dim account1 As String
    Dim account2 As String
    Dim account3 As String
    Dim account4 As String
    Dim account5 As String

'Naming which account worksheets need to be copied into the Master worksheet, only for use with Naming Method below
account1 = "x"
account2 = "xx"
account3 = "xxx"
account4 = "xxxx"
account5 = "xxxxx"

'Deleting any previous Master worksheet
For Each SheetExists In Worksheets
    If SheetExists.Name = "Master" Then
        Application.DisplayAlerts = False 'Turn off alerts to avoid annoyance
        SheetExists.Delete
        Application.DisplayAlerts = True 'Turn alerts back on
        Exit For
    End If
Next SheetExists

'Creating a blank Master worksheet based upon the Template worksheet
Set ws1 = ThisWorkbook.Worksheets("Template")
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = "Master"
ActiveSheet.Move before:=Worksheets(1) 'Moves Master worksheet to first tab

'Naming Method, selecting specific worksheets based upon names, for each additional worksheet name add another Or statement to the If Then line
For Each SheetExists In Worksheets
    If SheetExists.Name = account1 Or SheetExists.Name = account2 Or SheetExists.Name = account3 Or SheetExists.Name = account4 Or SheetExists.Name = account5 Then 'Matching worksheet names as needed
        SheetExists.Activate 'Make the sheet active
        Range("A1").Select
        Selection.CurrentRegion.Select 'Select all cells in this sheet
        Selection.Offset(2, 0).Resize(Selection.Rows.Count - 3).Select 'Select all rows except top and header
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)  'Copy cells selected into the Master sheet on the last line available
        Range("A1").Select 'Deselects entire worksheet so everything isn't highlighted
    End If
Next SheetExists

'Activates Master worksheet
Sheets(1).Activate
Rows("3:4").Delete 'Deletes blank lines from template

サブ終了

4

1 に答える 1