VBA Not Pasting Values into New Workbook Sheet - excel

Question

I created this script that applies conditional formatting to three pivot tables and attempts to save the results of each table into it's own tab in a new workbook.
Here is my code:
Sub conditional_formatting():
' Set dimensions
Dim i As Long
Dim rowCount As Long
Dim numOpen As Range
Dim Ws As Worksheet
Dim xWs1, xWs2, xWs3 As Worksheet
Dim NewBook As Workbook
Dim Nbs1, Nbs2, Nbs3 As Worksheet
Set NewBook = Workbooks.Add
With NewBook
Set Nbs1 = NewBook.Sheets("Sheet1")
NewBook.Sheets.Add.Name = "Sheet2"
Set Nbs2 = NewBook.Sheets("Sheet2")
NewBook.Sheets.Add.Name = "Sheet3"
Set Nbs3 = NewBook.Sheets("Sheet3")
End With
' loop through final report sheets
For Each Ws In ActiveWorkbook.Worksheets
' only loop through lic, loss loc, and reallocate reports
If Ws.Index > 4 And Ws.Index < 8 Then
If Ws.Index = 5 Then
' get the row number of the last row with data
rowCount = Cells(Rows.Count, "L").End(xlUp).Row
For i = 14 To rowCount
' Store number of weeks open in working cell
Set numOpen = Range("L" & i)
' Apply RAG conditional formatting
Select Case numOpen.Value
Case Is > 4
numOpen.Interior.ColorIndex = 3
Case Is > 2
numOpen.Interior.ColorIndex = 44
Case Else
numOpen.Interior.ColorIndex = 43
End Select
Next i
Ws.Range("A13:" & "L" & rowCount).Copy
Nbs1.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Nbs1.Name = "(lic)"
ElseIf Ws.Index = 6 Then
' get the row number of the last row with data
rowCount = Cells(Rows.Count, "L").End(xlUp).Row
For i = 11 To rowCount
' Store number of weeks open in working cell
Set numOpen = Range("L" & i)
' Apply RAG conditional formatting
Select Case numOpen.Value
Case Is > 4
numOpen.Interior.ColorIndex = 3
Case Is > 2
numOpen.Interior.ColorIndex = 44
Case Else
numOpen.Interior.ColorIndex = 43
End Select
Next i
Ws.Range("A10:" & "L" & rowCount).Copy
Nbs2.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Nbs2.Name = "(loss loc)"
Else
' get the row number of the last row with data
rowCount = Cells(Rows.Count, "L").End(xlUp).Row
For i = 13 To rowCount
' Store number of weeks open in working cell
Set numOpen = Range("L" & i)
' Apply RAG conditional formatting
Select Case numOpen.Value
Case Is > 4
numOpen.Interior.ColorIndex = 3
Case Is > 2
numOpen.Interior.ColorIndex = 44
Case Else
numOpen.Interior.ColorIndex = 43
End Select
Next i
Ws.Range("A12:" & "L" & rowCount).Copy
Nbs3.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Nbs3.Name = "(reallocate)"
End If
End If
Next Ws
NewBook.SaveAs Filename:="C:\Test1"
MsgBox ("Done")
End Sub
The script does not give me any errors, and it is successfully applying the conditional formatting, in addition to creating the correct tabs with the exception of renaming them as well.
For some reason, it's not actually pasting any values in the new workbook.
Any ideas?

Answer 1

I would try extracting the common code into separate subs.
Some other fixes included, such as qualifying every range with a worksheet object.
Sub conditional_formatting():
' Set dimensions
Dim rowCount As Long
Dim Ws As Worksheet
Dim NewBook As Workbook
Dim Nbs1 As Worksheet, Nbs2 As Worksheet, Nbs3 As Worksheet
Dim wbSrc As Workbook
Set wbSrc = ActiveWorkbook '<<<<remember this workbook
Set NewBook = Workbooks.Add
With NewBook
Set Nbs1 = .Sheets("Sheet1")
.Sheets.Add.Name = "Sheet2" '<< use your With here...
Set Nbs2 = .Sheets("Sheet2")
.Sheets.Add.Name = "Sheet3"
Set Nbs3 = .Sheets("Sheet3")
End With
' loop through final report sheets
For Each Ws In wbSrc.Worksheets
rowCount = Ws.Cells(Ws.Rows.Count, "L").End(xlUp).Row 'only need this once
If Ws.Index = 5 Then
FormatRange Ws.Range("L14:L" & rowCount)
CopyValues Ws.Range("A13:L" & rowCount), Nbs1.Range("A1")
Nbs1.Name = "(lic)"
ElseIf Ws.Index = 6 Then
FormatRange Ws.Range("L11:L" & rowCount)
CopyValues Ws.Range("A10:L" & rowCount), Nbs2.Range("A1")
Nbs2.Name = "(loss loc)"
ElseIf Ws.Index = 7 Then
FormatRange Ws.Range("L13:L" & rowCount)
CopyValues Ws.Range("A12:L" & rowCount), Nbs3.Range("A1")
Nbs3.Name = "(reallocate)"
End If
Next Ws
NewBook.SaveAs Filename:="C:\Test1"
MsgBox ("Done")
End Sub
'copy values from rngFrom into rngTo (resizing as necessary)
Sub CopyValues(rngFrom As Range, rngTo As Range)
With rngFrom
rngTo.Cells(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End Sub
'loop over and format a range according to cell values
Sub FormatRange(rng As Range)
Dim c As Range
For Each c In rng.Cells
Select Case c.Value
Case Is > 4
c.Interior.ColorIndex = 3
Case Is > 2
c.Interior.ColorIndex = 44
Case Else
c.Interior.ColorIndex = 43
End Select
Next c
End Sub