Excel链接的IF语句在宏更新后丢失单元格范围

Question

I've created a basic macro within a workbook to clear data from a set number of tabs then copy in refreshed data from external workbooks. There is a master data tab within the workbook that uses IF formulas to obtain various stock information for that tab which then feeds through to other sheets. EG

=IF($A$2="","",SUMIF(Data_CoventryStock!$A:$A,Data!$A$2,Data_CoventryStock!$E:$E))

Currently when the macro runs it produces the desired result but the IF Formulas lose the reference to the range eg $A:$A becomes #N/A!

I've been looking online for a solution but am unable to see a suitable option. I am new to this area.

Sub Update()
'
' Update Macro
'
Application.DisplayAlerts = False

' Clears data from tabs
    Sheets("Data_10Day").Select
    Columns("A:B").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Data_CoventryStock").Select
    Columns("A:E").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Data_CowleyStock").Select
    Columns("A:E").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Data_RugbyStock").Select
    Columns("A:B").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Data_10Day").Select

' Copies data from other workbooks then pastes

    Workbooks.Open Filename:= _
    "C:\Users\ceasdown\Documents\HDS\Data\Data_10Day.xlsx"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("Coventry Ordering Template2.xlsm").Activate
    Sheets("Data_10Day").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Workbooks("Data_10Day.xlsx").Close



    Workbooks.Open Filename:= _
    "C:\Users\ceasdown\Documents\HDS\Data\Data_CoventryStock.xlsx"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("Coventry Ordering Template2.xlsm").Activate
    Sheets("Data_CoventryStock").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Workbooks("Data_CoventryStock.xlsx").Close



   Workbooks.Open Filename:= _
    "C:\Users\ceasdown\Documents\HDS\Data\Data_CowleyStock.xlsx"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("Coventry Ordering Template2.xlsm").Activate
    Sheets("Data_CowleyStock").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Workbooks("Data_CowleyStock.xlsx").Close


    Workbooks.Open Filename:= _
    "C:\Users\ceasdown\Documents\HDS\Data\Data_RugbyStock.xlsx"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("Coventry Ordering Template2.xlsm").Activate
    Sheets("Data_RugbyStock").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Workbooks("Data_RugbyStock.xlsx").Close

   Application.DisplayAlerts = True

End Sub

I need it to retain the cell range in the IF formula so no manual update after running the macro is required.

Answer 1

I try to create a code avoiding .Select , .Activate and repetition. The code is untested but it will give you an idea about the concept. For any question please ask me.

Option Explicit

Sub Update()

    Dim ws As Worksheet
    '
    ' Update Macro
    '
    Application.DisplayAlerts = False

    ' Clears data from tabs

        For Each ws In ThisWorkbook

            With ws

                If .Name = "Data_10Day" Or .Name = "Data_RugbyStock" Then
                    .Columns("A:B").Delete Shift:=xlToLeft
                ElseIf .Name = "Data_CoventryStock" Or .Name = "Data_CowleyStock" Then
                    .Columns("A:E").Delete Shift:=xlToLeft
                End If

            End With

        Next ws

        ' Copies data from other workbooks then pastes
        Call Procedure("Data_10Day.xlsx", "Data_10Day")
        Call Procedure("Data_CoventryStock.xlsx", "Data_CoventryStock")
        Call Procedure("Data_CowleyStock.xlsx", "Data_CowleyStock")
        Call Procedure("Data_RugbyStock.xlsx", "Data_RugbyStock.xlsx")

   Application.DisplayAlerts = True

End Sub

Sub Procedure(ByVal FileName As String, ByVal SheetName As String)

    Workbooks.Open FileName:="C:\Users\ceasdown\Documents\HDS\Data\" & FileName

    Workbooks(FileName).Sheets("Sheet1").UsedRange.Copy

    Workbooks("Coventry Ordering Template2.xlsm").Sheets(SheetName).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Workbooks(FileName).Close

End Sub

Answer 2

The reason your formulas get damaged is that you are Deleting the ranges they refer to. Instead of deleting, use ClearContents instead.

Also, your code can do with quite a bit of optimsation.

Consider this

Sub Update()
    Dim wbMain As Workbook
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim FilePath As String

    Application.DisplayAlerts = False

    Set wbMain = ActiveWorkbook

    With wbMain
        FilePath = Environ$("UserProfile") & "\Documents\HDS\Data\"
        ' Copies data from other workbooks then pastes
        UpdateFromWB .Worksheets("Data_10Day").Cells(1, 1), FilePath & "Data_10Day.xlsx", "WhatSheet?"
        UpdateFromWB .Worksheets("Data_CoventryStock").Cells(1, 1), FilePath & "Data_CoventryStock.xlsx", "WhatSheet?"
        UpdateFromWB .Worksheets("Data_CowleyStock").Cells(1, 1), FilePath & "Data_CowleyStock.xlsx", "WhatSheet?"
        UpdateFromWB .Worksheets("Data_RugbyStock").Cells(1, 1), FilePath & "Data_RugbyStock.xlsx", "WhatSheet?"

    End With
    Application.DisplayAlerts = True
End Sub

Private Sub UpdateFromWB(rngDest As Range, wbName As String, wsName As String)
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range

    Set wb = Workbooks.Open(Filename:=wbName)
    Set ws = wb.Worksheets(wsName)
    With ws
        Set rng = .Range(.Cells(1, 1).End(xlDown), .Cells(1, 1).End(xlToRight))
        'Alternative, in case there might be gaps in the data
        'Set rng = .Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, .Columns.Count).End(xlToLeft))
    End With
    rngDest.Worksheet.Cells.ClearContents 'Delets ALL data from sheet.  Adjust range if required
    rngDest.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    wb.Close
End Sub