vba - 停止将新行格式更改为 Times New Roman

Question

我有两张表格，每张一张桌子。有时需要将 sheet1 中表格中的一些信息移动到表格 sheet2（我们称它们为 ApplicationsTable 和 FinishedTable）

我为此目的创建了按钮。首先，您必须选择需要复制的条目行，然后单击按钮，它会在 FinishedTable 的底部创建新行并填充来自 AplicationsTable 的信息。一切正常，除了由于某种原因创建的新行格式为 Times New Roman 11 pt。尽管 ApplicationsTable 和 FinishedTable 的其余部分的格式为 Arial 10 pt。

我曾尝试从 FinishedTable 的上方一行复制和粘贴格式，但由于某种原因我无法使其工作。您能给我一些建议，我应该采取什么方法来使新行保留原始表格格式？我的代码：

Sub Move_info()

Dim shNr As Worksheet
Dim fList As ListObject
Dim nEntry As ListRow
Dim lastRow As Long
Dim xForm As Long
Dim pForm As Long

Set sh1 = Worksheets("Register")
Set shNr = Worksheets("Finished applications")
Set fList = shNr.ListObjects("FinishedTable")
With fList.Range
    lastRow = .Rows(.Rows.Count).Row
End With

'stops macro if selected one than more row
If Selection.Rows.Count > 1 Then
    Exit Sub
End If

'if selected entry doesen't match criteria, stops from copying info
If Range("D" & (ActiveCell.Row)).Value = "Finished" Then
'line for adding new line at the bottom of the FinishedTable
    Set nEntry = fList.ListRows.Add
'Lines for moving info from ApplicationsTable to new row in FinishedTable

    With nEntry
        .Range(1) = shNr.Cells(lastRow, "A").Offset(-1, 0).Value + 1
        .Range(2) = "=Register!T" & ActiveCell.Row
        .Range(4) = sh1.Range("C" & ActiveCell.Row).Value
        .Range(6) = sh1.Range("I" & ActiveCell.Row).Value
        .Range(7) = sh1.Range("H" & ActiveCell.Row).Value
        .Range(10) = sh1.Range("P" & ActiveCell.Row).Value
        .Range(11) = sh1.Range("Q" & ActiveCell.Row).Value
        End With
    'Up to this part code works as intended, line created, info is moved

    'with code below I tried to copy format from one row above last and paste it to last row 
    'I do not get any error, but format remains unchanged

    xForm = shNr.Cells(lastRow, "A").Offset(-1, 0).Row
    Rows(xForm).Copy
    pForm = shNr.Cells(lastRow, "A").Row
    Rows(pForm).EntireRow.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False

    'selects first cell which where user have to write info by hand, works as intended
    Application.GoTo shNr.Cells(lastRow, "C").Offset(1, 0)
End If

End Sub

标签： vbaexcel

Answer 1

如果您知道该表从哪里开始（假设您的第一个数据行是 A2）​​，您可能可以执行以下操作：

Range("A2").CurrentRegion.Font.Name="Arial"
Range("A2").CurrentRegion.Font.Size=10.

这样，您可以将希望的格式应用于所有表格。

About why you have it in Times New roman, could be because it is the default format of Excel. To check it out, check the options in Excel. My version is 2007 and in Spanish, but I'll ad a screenshoot of how I do it. Maybe it can help you out.

First, click on the Office/File button and second, click on the Excel Options button:

And afther that, find section called something like Most frequent or Most used, and there you should have the option for the default format.

Hope this helps