H
Howard
Do I have something up-stream of the copy lines (both which error out) to make them fail?
Code is in a standard module
I have seven sheets commented out as I test the code.
Thanks,
Howard
Option Explicit
Sub ZeroOneDashIandN()
Dim c As Range
Dim i As Long
Dim j As String
Dim MyArr As Variant
Dim lr As Long
Dim rngB As Range
MyArr = Array("01-IN", "02-IN", "03-IN") ', "04-IN", "05-IN", "06-IN", "07-IN", "08-IN", "09-IN", "10-IN")
Application.ScreenUpdating = False
For i = LBound(MyArr) To UBound(MyArr)
With Sheets("Sales Forecast")
j = Range("B3").Value
lr = Cells(Rows.Count, 11).End(xlUp).Row
Set rngB = Range("B13:B" & lr)
For Each c In rngB
If c = j Then
c.Offset(, 2).Resize(1, 76).Copy
Sheets(i).Range("B" & Rows.Count) _
.End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
'Sheets(i).Range("B" & Rows.Count) _
.End(xlUp)(2) = c.Offset(, 2).Resize(1, 76)
End If
Next 'c
End With
Next 'i
Application.ScreenUpdating = True
End Sub
Code is in a standard module
I have seven sheets commented out as I test the code.
Thanks,
Howard
Option Explicit
Sub ZeroOneDashIandN()
Dim c As Range
Dim i As Long
Dim j As String
Dim MyArr As Variant
Dim lr As Long
Dim rngB As Range
MyArr = Array("01-IN", "02-IN", "03-IN") ', "04-IN", "05-IN", "06-IN", "07-IN", "08-IN", "09-IN", "10-IN")
Application.ScreenUpdating = False
For i = LBound(MyArr) To UBound(MyArr)
With Sheets("Sales Forecast")
j = Range("B3").Value
lr = Cells(Rows.Count, 11).End(xlUp).Row
Set rngB = Range("B13:B" & lr)
For Each c In rngB
If c = j Then
c.Offset(, 2).Resize(1, 76).Copy
Sheets(i).Range("B" & Rows.Count) _
.End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
'Sheets(i).Range("B" & Rows.Count) _
.End(xlUp)(2) = c.Offset(, 2).Resize(1, 76)
End If
Next 'c
End With
Next 'i
Application.ScreenUpdating = True
End Sub