Question

我在这个网站上找到了vba代码，因为我不得不根据唯一标识符（组织）将大型数据表拆分为单独的单个工作表。在源列表中，行标题使用粗体字和灰色背景进行格式化，但是当我运行宏时，新表缺少任何格式。我想要添加到我的VBA代码中的是在所有新工作表中保持行标题格式相同，而不是没有格式化的纯文本。由于信息的性质，我不能分享宏输出的例子。

以下链接将显示我的格式化行标题：

Row Headers with Formatting

这是我的vba代码：

Sub FilterToSheets()
Dim ws As Worksheet
Set ws = Sheets("Active & Inactive Accounts")
Dim LastRow As Long

LastRow = Range("A" & ws.Rows.Count).End(xlUp).Row

' stop processing if we don't have any data
If LastRow < 2 Then Exit Sub

Application.ScreenUpdating = False
SortMasterList LastRow, ws
CopyDataToSheets LastRow, ws
ws.Select
Application.ScreenUpdating = True
End Sub

Sub SortMasterList(LastRow As Long, ws As Worksheet)
ws.Range("A2:H" & LastRow).Sort Key1:=ws.Range("A1"), Key2:=ws.Range("B1")
End Sub

Sub CopyDataToSheets(LastRow As Long, src As Worksheet)
Dim rng As Range
Dim cell As Range
Dim Series As String
Dim SeriesStart As Long
Dim SeriesLast As Long

Set rng = Range("A2:A" & LastRow)
SeriesStart = 2
Series = Range("A" & SeriesStart).Value
For Each cell In rng
    If cell.Value <> Series Then
        SeriesLast = cell.Row - 1
        CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series
        Series = cell.Value
        SeriesStart = cell.Row
    End If
Next
' copy the last series
SeriesLast = LastRow
CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series

End Sub

Sub CopySeriesToNewSheet(src As Worksheet, Start As Long, Last As Long, _
                                                    name As String)

name = Left(name, 31)
Dim tgt As Worksheet

Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = name
Set tgt = Sheets(name)

' copy header row from src to tgt
tgt.Range("A1:H1").Value = src.Range("A1:H1").Value

' copy data from src to tgt
tgt.Range("A2:H" & Last - Start + 2).Value = _
    src.Range("A" & Start & ":H" & Last).Value
End Sub

Function SheetExists(name As String) As Boolean
Dim ws As Worksheet

SheetExists = True
On Error Resume Next
Set ws = Sheets(name)
If ws Is Nothing Then
   SheetExists = False
End If
End Function

如果也可以，我希望在所有工作表中保持单元格间距相同，因为宏会压缩新工作表中的数据。

Where I found my vba code

分离数据并放入单个工作表Excel VBA时，保持行标题格式

0 个答案: