Still not working. Here's what I'm trying to do. I have a workbook that
someone else created with staffing data. In one of their worksheets, they've
used VLOOKUPS to make a data range dynamic based on the value of cell B2.
That's in the sheet named "Individuals".
I've created another sheet named "Indiv Stmts", where I've used VLOOKUPS as
well to pull the data from the appropriate cells in Individuals, and added a
chart at the bottom to graphically display the data. I want to loop through a
list of names in cells A4:A28 (or exiting the loop when the value of the next
cell is blank) in the sheet "Individuals" and set the value of cell B2 to the
name, then recalculate, thereby refreshing the data in my Indiv Stmts sheet.
Then I want to copy just that sheet to a new workbook, naming both the sheet
and the workbook with that person's name, thereby creating individual
workbooks for each person. Here is the whole module:
Sub IndivWkbk()
'Creates individual associate worksheets with estimated client hours for
each of their clients
Dim myWkk As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim WSNew As Worksheet
Dim cell As Range
Dim FolderName As String
Dim MyPath As String
Dim ansprint As String, msg As String, title As String, style As String
Dim strWorkBookName As String '
Dim r As Integer
Dim c As Integer
Dim rw As Integer
Set myWkb = ActiveWorkbook
With myWkb
Set ws1 = .Worksheets("Individuals")
Set ws2 = .Worksheets("Indiv Stmt")
End With
Set cell = ws1.Range("B2")
MyPath = ActiveWorkbook.Path
r = 4
c = 1
'Add a slash at the end of the path
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'Create folder for the new files
FolderName = MyPath & "Indiv Stmts " & Format(Now, "yyyy-mm-dd") & "\"
MkDir FolderName
'Message Box asks user if they want to print statements
msg = "New workbooks will be created for each associate. Do you want to
print individual statements?"
style = vbYesNo
title = "Print Statements?"
ansprint = MsgBox(msg, style, title)
With ws1
Do While r > 0
cell.Value = Cells(r, 1)
Application.Calculate
'Add new workbook with one sheet
Set WSNew = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
WSNew.Name = cell.Value
'Copy the individual statement to new workbook
With ws2 'Indiv Stmts
.Range("$A$1:$P$42").Copy
End With
With WSNew.Range("A1")
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
For rw = 11 To 18
With WSNew.Rows(rw)
If Cells(rw, 1) = "" Then
.RowHeight = 0
End If
End With
Next
'Save the file in the newfolder and close it
WSNew.Parent.SaveAs FolderName & cell.Value, ws1.Parent.FileFormat
WSNew.Parent.Close False
If ansprint = "Yes" Then
strWorkBookName = FolderName & cell.Value & ".xls"
Workbooks.Open (strWorkBookName)
With Worksheets(cell.Value)
.PageSetup.PrintArea = "$A$1:$P$42"
.PageSetup.Orientation = xlLandscape
.PrintOut
End With
ActiveWorkbook.Close True
End If
r = r + 1
If Cells(r, 1) = "" Then
r = 0
End If
Loop
End With
MsgBox "Files have been created in " & FolderName
End Sub
********************
So far the code never sets the myWkb variable, so of course it's not setting
the worksheet variables either.
