lundi 23 octobre 2017

Copy/paste multiple ranges VBA with condition

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