Code copies ONLY last j from sheet

Giganews Newsgroups
Subject: Code copies ONLY last j from sheet
Posted by:  Howard (lhkitt…
Date: Wed, 11 Dec 2013

With j = Sheets(MyArr(i)).Range("B9").Value there should be several j's copied to each Sheets(MyArr(i)).Range("B" & Rows.Count).End(xlUp)(2)

The code copies only the last j from "Sales Forecast" to Sheets(MyArr(i)).

Do you see anything in the code that prevents all the j's to be coped to the proper sheet.

I have great confidence in the code since I got help from Claus of this Group, I only changed the value of j from a single sheet cell B9 to the "current" sheet
B9.  And each sheet has a different value in B9.


Option Explicit

Sub ZeroOneDashIandNTester()
Dim c As Range
Dim i As Long
Dim j As String
Dim MyArr As Variant
Dim varOut As Variant
Dim lr As Long
Dim rngB As Range

MyArr = Array("HC-01 (IN)", "HC-02 (IN)", "HC-03 (IN)", _
              "HC-04 (IN)", "HC-05 (IN)", "HC-06 (IN)", _
              "HC-07 (IN)", "HC-08 (IN)", "HC-09 (IN)", "HC-10 (IN)")

Application.ScreenUpdating = False

For i = LBound(MyArr) To UBound(MyArr)

  With Sheets("Sales Forecast")

      j = Sheets(MyArr(i)).Range("B9").Value

      lr = .Cells(.Rows.Count, 11).End(xlUp).Row
      Set rngB = .Range("B6:B" & lr)

      For Each c In rngB
        If c = j Then
            varOut = c.Offset(, 2).Resize(, 76)
            Sheets(MyArr(i)).Range("B" & Rows.Count) _
            .End(xlUp)(2).Resize(columnsize:=76) = varOut
        End If
    Next 'c

  End With
Next 'i

Application.ScreenUpdating = True
End Sub