Excel Forum

Code: Select all

Sub CreateOrUpdateData()
    Dim shBk As Worksheet
    Dim rngScrs As Range, rngScr As Range
    Dim f As Long
    Dim rngAll As Range, rng As Range
    Dim rngBay As Range
    
    With Worksheets("BackupData")
        Set rngAll = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    End With
    
    With Worksheets("tag")
        If .Range("a3").Value = "" Then Exit Sub
        Set rngScrs = .Range("a3", .Range("a" & .Rows.Count).End(xlUp))
    End With
    
    For Each rngScr In rngScrs
        If Application.CountIfs(rngAll.Offset(0, 4), rngScr.Value) > 0 Then
            For Each rng In rngAll
                If rng.Offset(0, 4).Value = rngScr.Value Then
                    rng.Resize(, 4).Value = rngScr.Resize(, 4).Value
                End If
            Next rng
        Else
            With Worksheets("BackupData")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(, 4).Value = _
                    rngScr.Resize(, 4).Value
            End With
        End If
    Next rngScr
    
End Sub