Question

我正在尝试复制并粘贴＆＃34; masterrow＆＃34;的格式和公式。到循环中的范围。该循环还从另一个工作簿中获取数据，因此在循环期间它是ActiveWorkbook。

我在想这个＆＃34; ActiveWorkbook＆＃34;问题是导致问题的原因，但我需要帮助解决方案。我在下面提供了循环功能。我希望你能帮助我。

Sub Worksheet_UpdateAllItemCostData()

Dim material As Variant
Dim fndEntry As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim lr As Long, I As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb1 = ActiveWorkbook

lr = wb1.Sheets("Sagsnr.").Cells(Rows.Count, "C").End(xlUp).Row

If lr < 21 Then
    Exit Sub
End If

Workbooks.Open Filename:="G:\Backoffice\Tilbudsteam\Kostdatabase\Matcost.xls", ReadOnly:=True

Set wb2 = ActiveWorkbook

    For I = 21 To lr

            wb1.Sheets("Sagsnr.").Rows("1:1").Select
            selection.Copy
            wb1.Sheets("Sagsnr.").Rows(I).Select
            selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
            SkipBlanks:=True, Transpose:=False
            selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            selection.EntireRow.Hidden = False

    material = wb1.Sheets("Sagsnr.").Range("C" & I).Value

    Set fndEntry = wb2.Sheets("Matcost").Range("D:D").Find(What:=material)

    If Not fndEntry Is Nothing Then

            wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group
            wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value   'Available Stock

        End If

    Set fndEntry = wb2.Sheets("Matcost").Range("C:C").Find(What:=material)

        If Not fndEntry Is Nothing Then

            wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group
            wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value   'Available Stock

        End If
Next I

wb2.Close

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Answer 1

正如您所说，当您激活ActiveWorkbook时可能会出现wb2问题，您应该尝试这样做：

Set wb2 = Workbooks.Open (Filename:="G:\Backoffice\Tilbudsteam\Kostdatabase\Matcost.xls", ReadOnly:=True)

而不是

Workbooks.Open Filename:="G:\Backoffice\Tilbudsteam\Kostdatabase\Matcost.xls", ReadOnly:=True

Set wb2 = ActiveWorkbook

此外，如果您的代码位于wb1，则可以避开ActiveWorkbook并执行：

Set wb1 = ThisWorkbook

作为补充建议，您应该尽量避免代码How to avoid Select in Excel VBA macros中的.Select

尝试在循环中复制/粘贴公式和格式时VBA错误400

1 个答案: