Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Copy Column D from all worksheets in WB1 and paste in sheet1 WB2
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Copy Column D from all worksheets in WB1 and paste in sheet1 WB2
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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 703
Default Copy Column D from all worksheets in WB1 and paste in sheet1 WB2
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
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

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Copy Column D from all worksheets in WB1 and paste in sheet1 W
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
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


Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Copy Column D from all worksheets in WB1 and paste in sheet1 W
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
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


Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 703
Default Copy Column D from all worksheets in WB1 and paste in sheet1 W
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?

Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 703
Default Copy Column D from all worksheets in WB1 and paste in sheet1 W
Thanks for your reply. I'm glad that you found the error.

Best regards,
Per


On 13 Nov., 04:01, farid2001
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
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- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -

Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Copy Column D from all worksheets in WB1 and paste in sheet1 W
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?


Reply With QuoteReply With Quote
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,533
Default Copy Column D from all worksheets in WB1 and paste in sheet1 W
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?



Reply With QuoteReply With Quote
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Copy Column D from all worksheets in WB1 and paste in sheet1 W
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?




Reply With QuoteReply With Quote
  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,533
Default Copy Column D from all worksheets in WB1 and paste in sheet1 W
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?





Reply With QuoteReply With Quote
  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Copy Column D from all worksheets in WB1 and paste in sheet1 W
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?






Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
How to copy from sheet1 then paste special transpose to sheet2,3,4 Christine Excel Discussion (Misc queries) 2 July 22nd 09 09:50 PM
Need to copy rows in Sheet1 to different worksheets minx2001[_3_] Excel Programming 0 October 23rd 04 05:44 PM
Need to copy rows in Sheet1 to different worksheets minx2001[_2_] Excel Programming 1 October 23rd 04 04:00 PM
Need to copy rows in Sheet1 to different worksheets minx2001 Excel Programming 1 October 23rd 04 10:13 AM
Search, find, copy from sheet1 and paste into sheet2 lothario[_47_] Excel Programming 4 November 9th 03 09:07 AM


All times are GMT +1. The time now is 10:17 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement