Per

Awesome!!
Your code worked to perfection.

Sub CopyCalcCols()

Dim wbA As Workbook
Dim wbB As Workbook
Dim DestSh As Worksheet
Dim off As Long
Dim r As Long
Dim LastRow As Long
Dim TargetRow As Long
Set wbA = ThisWorkbook
Set wbB = Workbooks("Master.xlsx")
Set DestSh = wbB.Worksheets("Hoja1")
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
If wbA.Worksheets(sh.Name).Range("D4").End(xlDown).Ro w = 202 Then
wbA.Worksheets(sh.Name).Columns("D").Copy _
Destination:=DestSh.Range("C1").Offset(0, off)
Else
LastRow = wbA.Worksheets(sh.Name).Range("D4").End(xlDown).Ro w - 1
For r = 4 To LastRow
TargetRow = Application.WorksheetFunction.Match(wbA.Worksheets _
(sh.Name).Cells(r, 2).Value, DestSh.Range("A2:A201"), 1)
wbA.Worksheets(sh.Name).Cells(r, 4).Copy _
Destination:=DestSh.Cells(TargetRow + 1, 3 + off)
Next
End If
off = off + 1
Next
Application.ScreenUpdating = True
End Sub

Thanks & regards
Farid

"Per Jessen" wrote:

Farid,
Which line throws the error ?

Does the two first sheets have 200 lines.

If you want you can send me a sample workbook which I can use to test the
macro.

Regards,
Per

"farid2001" skrev i meddelelsen
...
Per
Thanks for your help.
It does work but only does the first 2 worksheets, then I get error
message
'1004'
"Error defined by object or application"

Regards
Farid

"Per Jessen" wrote:

Hi

Try this (not tested)

Sub CopyCols()
Dim wbA As Workbook
Dim wbB As Workbook
Dim DestSh As Worksheet
Dim off As Long
Dim r As Long
Dim LastRow As Long
Dim TargetRow As Long

Set wbA = ThisWorkbook
Set wbB = Workbooks("Book2") ' Change to suit
Set DestSh = wbB.Worksheets("Sheet1")

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
If wbA.Worksheets(sh.Name).Range("D2").End(xlDown).Ro w = 201 Then
wbA.Worksheets(sh.Name).Columns("D").Copy _
Destination:=DestSh.Range("C1").Offset(0, off)
Else
LastRow = wbA.Worksheets(sh.Name).Range("D2").End(xlDown).Ro w
For r = 2 To LastRow
TargetRow =
Application.WorksheetFunction.Match(wbA.Worksheets _
(sh.Name).Cells(r, 2).Value, DestSh.Range("A2:A201"), 1)
wbA.Worksheets(sh.Name).Cells(r, 4).Copy _
Destination:=DestSh.Cells(TargetRow, 3 + off)
Next
End If
off = off + 1
Next
Application.ScreenUpdating = True
End Sub

Regards,
Per

"farid2001" skrev i meddelelsen
...
Per
Not all worksheets in wbA column D have the same # of rows
Column B has customer ID and column D has dollars used.
wbB has in Range A2:A201 the ID's of the 200 customers I have.
Range B2:B201 customer name
therefore the formula I use to determine who spent dollars is:
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX('[Child June
2008.xlsx]01-06'!R4C4:R136C4,MATCH(RC[-2],'[Child June
2008.xlsx]01-06'!R4C2:R136C2,0)),0)"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C201")
Range("C2:C201").Select
What should the code be instead of Copy Destination?

Thank you very much for your help.
Regards
Farid

"Per Jessen" wrote:

Which line throws the the error?

Regards,
Per

On 13 Nov., 03:53, farid2001
wrote:
Thank you for your fast response.
I get error9 message, "Sub Index out of....
What could be wrong?