That's a start in the right direction! Thanks for taking your time on the
Christmas Day!!

"Don Guillett" wrote:

I have no experience with looping.
But your macro is full of looping

for i=
code
next

is a loop so

for i=1 to 30
With wbData.Sheets(i)
next i

No need to copy each in contigous range
Range("k1:k5").Value = Range("j14:j18").Value

''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"
Why not just use FIND instead of the loop here? Something like
if cells.find(.cells(xv,1) then
xr=xv
else
xr=3
end if

etc,
Merry Xmas
--
Don Guillett
SalesAid Software

"David" wrote in message
...
I have a macro to copy specific cells on 30 worksheets and paste that data
to
another workbook to specific cells on 30 worksheets. The target workbook
has
a column for the date of the source workbook. I'm getting a Project too
large
error and think a loop procedure would fix the problem. I know there must
be
a much simplier solution but I have no experience with looping. Here is
the
code for the first 2 pages...it simply repeats until the 30th page.

Sub CapturePlumberData()
Dim wbSum As Workbook, wbData As Workbook
Set wbSum = Workbooks("2006 Consolidated Plumber File.xls")
Set wbData = ActiveWorkbook

' get source data from open sheet
Dim iOffice As Integer, iDate As Date, iValue '==IOffice is not needed==

'First Sheet - Need to do this for all 30 sheets
With wbData.Sheets(4)
'Don't need the ioffice Range
iOffice = .Range("J6")
iDate = .Range("C11")
With wbData.Sheets(4)
iValueSG = .Range("J15")
iValueAS = .Range("J16")
iValueV = .Range("J17")
iValueCR = .Range("J18")
iValueCC = .Range("J19")
iValueCRate = .Range("J20")
iValueAVGS = .Range("J21")
iValueRHW = .Range("J22")
iValueOHW = .Range("J23")
iValueLWP = .Range("J24")
iValueWPPS = .Range("J25")
ivalueRV = .Range("J26")
iValueBFSS = .Range("J27")
iValueBMV = .Range("J28")
iValueBIO = .Range("J29")
iValueRW = .Range("H33")
iValueOW = .Range("H34")
iValueBN = .Range("J31")
iValueSP = .Range("J32")
iValueTB = .Range("J33")
iValueTH = .Range("J34")
iValueTAW = .Range("J35")
iValueTWPPS = .Range("J36")

End With

' Set Px Sheets and apply all values

' apply iValueSG - Sales Goal to matched row and column
With wbSum.Sheets(2)
Dim lastrow As Long, lastcol As Long, xV As Long, xR As Long, xC As
Long
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 2
' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR 0 And xC 0 Then .Cells(xR, xC) = iValueSG
End With

' apply iValueAS - Actual Sales to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 3

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR 0 And xC 0 Then .Cells(xR, xC) = iValueAS
End With

' apply iValueV - Sales Variance to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column

''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 4

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR 0 And xC 0 Then .Cells(xR, xC) = iValueV
End With

' apply iValueCR - Calls Run to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 5

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR 0 And xC 0 Then .Cells(xR, xC) = iValueCR
End With

' apply iValueCC - Calls Closed to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 6

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR 0 And xC 0 Then .Cells(xR, xC) = iValueCC
End With

' apply iValueCRate - Calls Closed Rate to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 7

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR 0 And xC 0 Then .Cells(xR, xC) = iValueCRate
End With

' apply iValueAVGS - Average Sale to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 8

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR 0 And xC 0 Then .Cells(xR, xC) = iValueAVGS
End With

' apply iValueRHW - Regular Hours Worked to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 9

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR 0 And xC 0 Then .Cells(xR, xC) = iValueRHW
End With

' apply iValueOHW - OverTime Hours Worked to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary
Table"

' set row manually
xR = 10

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR 0 And xC 0 Then .Cells(xR, xC) = iValueOHW
End With

' apply iValueLWP - Labor Wages Paid to matched row and column
With wbSum.Sheets(2)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
''get matching row
'For xV = 1 To lastrow
'If iOffice = .Cells(xV, 1) Then xR = xV
'Next xV
'If xR = 0 Then MsgBox "Office: " & iOffice & " not found in summary