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 这可以帮助您更轻松地发现代码中的任何错误输入。当您尝试运行您的代码时，所有这一切都会抛出一个错误 'Variable Not Defined'，因为 FileInputpath 没有在您的代码中的任何地方使用。当你的代码没有错误地工作时，我建议在 Code Review 中使用 post，因为它们可以帮助更多工作代码，但不完全符合预期（或者你觉得可以写得更好）

您的代码无法运行的原因可能是因为 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

VBA 粘贴时改变大小

VBA Change size when is pasting

vba

copy-paste

font-size