Hello
I need help with code.
I have Workbook A with 70+ worksheets, and I want to copy contents from
column D from each worksheet and paste in Workbook B Sheet1 so that it looks
like:

Column C Column D Column E Column F
Col D sht1 Col D sht2 Col D sht3 Col D sht4

and so on.
Is this possible?
Please help me.
Thanks & regards
farid2001

Hi

I think this should do it:

Sub CopyCols()
Dim wbA As Workbook
Dim wbB As Workbook
Dim DestSh As Worksheet
Dim off 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
wbA.Worksheets(sh.Name).Columns("D").Copy Destination:=DestSh.Range
("C1").Offset(0, off)
off = off + 1
Next
Application.ScreenUpdating = True
End Sub

Regards,
Per

On 13 Nov., 02:28, farid2001 <farid2...@discussions.microsoft.com>
wrote:
> Hello
> I need help with code.
> I have Workbook A with 70+ worksheets, and I want to copy contents from
> column D from each worksheet and paste in Workbook B Sheet1 so that it looks
> like:
>
> *Column C * *Column D * * Column E * * *Column F
> *Col D sht1 * Col D sht2 * * Col D sht3 * * Col D sht4
>
> and so on.
> Is this possible?
> Please help me.
> Thanks & regards
> farid2001

Thank you for your fast response.
I get error9 message, "Sub Index out of....
What could be wrong?

"Per Jessen" wrote:

> Hi
>
> I think this should do it:
>
> Sub CopyCols()
> Dim wbA As Workbook
> Dim wbB As Workbook
> Dim DestSh As Worksheet
> Dim off 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
> wbA.Worksheets(sh.Name).Columns("D").Copy Destination:=DestSh.Range
> ("C1").Offset(0, off)
> off = off + 1
> Next
> Application.ScreenUpdating = True
> End Sub
>
> Regards,
> Per
>
> On 13 Nov., 02:28, farid2001 <farid2...@discussions.microsoft.com>
> wrote:
> > Hello
> > I need help with code.
> > I have Workbook A with 70+ worksheets, and I want to copy contents from
> > column D from each worksheet and paste in Workbook B Sheet1 so that it looks
> > like:
> >
> > Column C Column D Column E Column F
> > Col D sht1 Col D sht2 Col D sht3 Col D sht4
> >
> > and so on.
> > Is this possible?
> > Please help me.
> > Thanks & regards
> > farid2001
>
>

Per
Thanks a million, it worked perfectly, I forgot to write .xslx

Regards
farid2001

"farid2001" wrote:

> Thank you for your fast response.
> I get error9 message, "Sub Index out of....
> What could be wrong?
>
> "Per Jessen" wrote:
>
> > Hi
> >
> > I think this should do it:
> >
> > Sub CopyCols()
> > Dim wbA As Workbook
> > Dim wbB As Workbook
> > Dim DestSh As Worksheet
> > Dim off 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
> > wbA.Worksheets(sh.Name).Columns("D").Copy Destination:=DestSh.Range
> > ("C1").Offset(0, off)
> > off = off + 1
> > Next
> > Application.ScreenUpdating = True
> > End Sub
> >
> > Regards,
> > Per
> >
> > On 13 Nov., 02:28, farid2001 <farid2...@discussions.microsoft.com>
> > wrote:
> > > Hello
> > > I need help with code.
> > > I have Workbook A with 70+ worksheets, and I want to copy contents from
> > > column D from each worksheet and paste in Workbook B Sheet1 so that it looks
> > > like:
> > >
> > > Column C Column D Column E Column F
> > > Col D sht1 Col D sht2 Col D sht3 Col D sht4
> > >
> > > and so on.
> > > Is this possible?
> > > Please help me.
> > > Thanks & regards
> > > farid2001
> >
> >

Which line throws the the error?

Regards,
Per

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

Thanks for your reply. I'm glad that you found the error.

Best regards,
Per


On 13 Nov., 04:01, farid2001 <farid2...@discussions.microsoft.com>
wrote:
> Per
> Thanks a million, it worked perfectly, I forgot to write .xslx
>
> Regards
> farid2001
>
>
>
> "farid2001" wrote:
> > Thank you for your fast response.
> > I get error9 message, "Sub Index out of....
> > What could be wrong?
>
> > "Per Jessen" wrote:
>
> > > Hi
>
> > > I think this should do it:
>
> > > Sub CopyCols()
> > > Dim wbA As Workbook
> > > Dim wbB As Workbook
> > > Dim DestSh As Worksheet
> > > Dim off 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
> > > * * wbA.Worksheets(sh.Name).Columns("D").Copy Destination:=DestSh.Range
> > > ("C1").Offset(0, off)
> > > * * off = off + 1
> > > Next
> > > Application.ScreenUpdating = True
> > > End Sub
>
> > > Regards,
> > > Per
>
> > > On 13 Nov., 02:28, farid2001 <farid2...@discussions.microsoft.com>
> > > wrote:
> > > > Hello
> > > > I need help with code.
> > > > I have Workbook A with 70+ worksheets, and I want to copy contents from
> > > > column D from each worksheet and paste in Workbook B Sheet1 so thatit looks
> > > > like:
>
> > > > *Column C * *Column D * * Column E * * *Column F
> > > > *Col D sht1 * Col D sht2 * * Col D sht3 * * Col D sht4
>
> > > > and so on.
> > > > Is this possible?
> > > > Please help me.
> > > > Thanks & regards
> > > > farid2001- Skjul tekst i anførselstegn -
>
> - Vis tekst i anførselstegn -

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 <farid2...@discussions.microsoft.com>
> wrote:
> > Thank you for your fast response.
> > I get error9 message, "Sub Index out of....
> > What could be wrong?
> >
>

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).Row = 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).Row
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" <(E-Mail Removed)> skrev i meddelelsen
news:A77C6444-733F-4581-BA0D-(E-Mail Removed)...
> 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 <farid2...@discussions.microsoft.com>
>> wrote:
>> > Thank you for your fast response.
>> > I get error9 message, "Sub Index out of....
>> > What could be wrong?
>> >
>>

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).Row = 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).Row
> 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" <(E-Mail Removed)> skrev i meddelelsen
> news:A77C6444-733F-4581-BA0D-(E-Mail Removed)...
> > 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 <farid2...@discussions.microsoft.com>
> >> wrote:
> >> > Thank you for your fast response.
> >> > I get error9 message, "Sub Index out of....
> >> > What could be wrong?
> >> >
> >>
>
>

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" <(E-Mail Removed)> skrev i meddelelsen
news:B10BD094-2F8B-4521-9F9F-(E-Mail Removed)...
> 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).Row = 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).Row
>> 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" <(E-Mail Removed)> skrev i meddelelsen
>> news:A77C6444-733F-4581-BA0D-(E-Mail Removed)...
>> > 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 <farid2...@discussions.microsoft.com>
>> >> wrote:
>> >> > Thank you for your fast response.
>> >> > I get error9 message, "Sub Index out of....
>> >> > What could be wrong?
>> >> >
>> >>
>>
>>