I am trying to copy/paste multiple ranges avoiding paste where there is a formula in the target. The code below works for the rSource/rTarget only. It doesn't work for the rest of sources/targets. I need to copy/paste for all of them. Please advise.
Thanks!
Sub UpdatePickUpShortCode()
Dim rSource As Range, sSource As Range, tSource As Range, uSource As Range, multipleRange As Range
Dim rTarget As Range, sTarget As Range, tTarget As Range, uTarget As Range
Set rSource = ActiveSheet.Range("Z18:AA250")
Set sSource = ActiveSheet.Range("W18:X250")
Set tSource = ActiveSheet.Range("H18:H250")
Set uSource = ActiveSheet.Range("O18:O250")
Set rTarget = ActiveSheet.Range("AU18:AV250")
Set sTarget = ActiveSheet.Range("AX18:AY250")
Set tTarget = ActiveSheet.Range("AR18:AR250")
Set uTarget = ActiveSheet.Range("AS18:AS250")
Set multipleRange = Union(rSource, sSource, tSource, uSource, rTarget, sTarget, tTarget, uTarget)
For Item = 1 To rSource.Count
If Not rTarget.Cells(Item).HasFormula Then
rTarget.Cells(Item).Value = rSource.Cells(Item).Value
End If
Next Item
For Item1 = 1 To sSource.Count
If Not sTarget.Cells(Item).HasFormula Then
sTarget.Cells(Item).Value = sSource.Cells(Item).Value
End If
Next Item1
For Item2 = 1 To tSource.Count
If Not tTarget.Cells(Item).HasFormula Then
tTarget.Cells(Item).Value = tSource.Cells(Item).Value
End If
Next Item2
For Item3 = 1 To uSource.Count
If Not uTarget.Cells(Item).HasFormula Then
uTarget.Cells(Item).Value = uSource.Cells(Item).Value
End If
Next Item3
End Sub
Aucun commentaire:
Enregistrer un commentaire