粘贴时VBA更改大小

Question

我正在尝试从一个文件复制信息并粘贴到另外两个文件，但是当它粘贴时，它会更改字体大小。我只有一个文件（编译数据）有这个问题。我还在学习 VBA，所以我可能遗漏了一些东西......

Sub Sites()
Application.ScreenUpdating = False

Dim InputFile As Workbook
Dim OutputFile As Workbook
Dim FormulasFile As Workbook
Dim Inputpath As String
Dim Outputpath As String
Dim Formulaspath As String
Dim lRow As Long
Dim ws As Worksheet

'Set path for files
fileInputpath = "C:\Users\Workbooks\"
Outputpath = "C:\Users\Workbooks\"
Formulaspath = "C:\Users\Workbooks\"

'Open workbooks first
Set InputFile = Workbooks.Open(Inputpath & "C:\Users\Workbooks\Weekly data.xlsx")
Set OutputFile = Workbooks.Open(Outputpath & "Compiled data.xlsx")
Set FormulasFile = Workbooks.Open(Formulaspath & "Formulas Pivot data.xlsx", UpdateLinks:=False)

'Now, copy what you want from InputFile and paste to OutputFile/FormulasFile worksheet
With InputFile.Sheets("Report")
lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range("C3:O" & lRow).Copy OutputFile.Sheets("Sheet1").Cells(OutputFile.Sheets("Sheet1").Rows.Count, "A").End(xlUp).Offset(1)

'****This part is not working
For Each ws In Worksheets
With ws
.Cells.Font.Name = "Calibri"
.Cells.Font.Size = 9
End With
Next ws

End With

'this part is working fine
With InputFile.Sheets("Report")
lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range("C3:O" & lRow).Copy FormulasFile.Sheets("Site").Cells(FormulasFile.Sheets("Site").Rows.Count, "O").End(xlUp).Offset(1)

For Each ws In Worksheets
With ws
.Cells.Font.Name = "Calibri"
.Cells.Font.Size = 9
End With
Next ws

End With

'Close all files without display alerts
Application.DisplayAlerts = False
InputFile.Close False
OutputFile.Close True
FormulasFile.Close True
Application.ScreenUpdating = True

End Sub

Answer 1

首先，我建议启用Option Explicit，这可以帮助您更轻松地发现代码中的任何错误输入。当您尝试运行代码时，所有这一切都会抛出错误“未定义变量”，因为您的代码中的任何地方都没有使用FileInputpath。当您的代码正常运行时，我建议您在Code Review 中发帖，因为它们可以帮助您更好地处理工作代码，但并不完全符合预期（或者您觉得可以写得更好）

您的代码不工作的原因可能是因为Worksheets 将在ActiveWorkbook 上工作，除非另有定义。您的代码将是“Formulas Pivot data.xlsx”文件。以下内容希望对您有所帮助，请问您是否需要澄清任何事情

Option Explicit

Sub Sites()
Application.ScreenUpdating = False

Dim InputFile As Workbook
Dim OutputFile As Workbook
Dim FormulasFile As Workbook
Dim Inputpath As String
Dim Outputpath As String
Dim Formulaspath As String
Dim lRow As Long
Dim ws As Worksheet

'Set path for files
Inputpath = "C:\Users\Workbooks\"
Outputpath = "C:\Users\Workbooks\"
Formulaspath = "C:\Users\Workbooks\"

'Open workbooks first
Set InputFile = Workbooks.Open(Inputpath & "Weekly data.xlsx")
Set OutputFile = Workbooks.Open(Outputpath & "Compiled data.xlsx")
Set FormulasFile = Workbooks.Open(Formulaspath & "Formulas Pivot data.xlsx", UpdateLinks:=False)

'Now, copy what you want from InputFile and paste to OutputFile/FormulasFile worksheet
With InputFile.Sheets("Report")
    lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    .Range("C3:O" & lRow).Copy OutputFile.Sheets("Sheet1").Cells(OutputFile.Sheets("Sheet1").Rows.Count, "A").End(xlUp).Offset(1)
    
    '****This part is not working
    For Each ws In OutputFile.Worksheets
        With ws
            .Cells.Font.Name = "Calibri"
            .Cells.Font.Size = 9
        End With
    Next ws
    
End With

'this part is working fine
With InputFile.Sheets("Report")
    lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    .Range("C3:O" & lRow).Copy FormulasFile.Sheets("Site").Cells(FormulasFile.Sheets("Site").Rows.Count, "O").End(xlUp).Offset(1)
    
    For Each ws In FormulasFile.Worksheets
        With ws
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 9
        End With
    Next ws
    
End With

'Close all files without display alerts
Application.DisplayAlerts = False
InputFile.Close False
OutputFile.Close True
FormulasFile.Close True
Application.ScreenUpdating = True

End Sub