ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Copying data from several worksheets and merging into a new worksheet (https://www.excelbanter.com/excel-programming/302018-copying-data-several-worksheets-merging-into-new-worksheet.html)

Lost[_5_]

Copying data from several worksheets and merging into a new worksheet
 
I am trying to put data that is in columns from several
worksheets into another worksheet in row form. I
recorded a macro with a few of the sheets , I have
numerous worksheets, upwards of
40, and I was hoping that someone can help me to find
a way to record the selected data from all the sheets in
the workbook without going through every worksheet. **I
hope I was clear. Thank you in
advance for your help.
The recorded macro:

Sub Macro3try()
'
' Macro3try Macro
' Macro recorded 6/17/04
'

'
****With ActiveWindow
********.Top = 48
********.Left = 19
****End With
****Range("D4:D5").Select
****Selection.Copy
****Sheets.Add
****Range("A1").Select
****ActiveSheet.Paste
****Sheets("20040602").Select
****Range("A13:A25").Select
****Application.CutCopyMode = False
****Selection.Copy
****Sheets("Sheet3").Select
****Range("B1").Select
****Selection.PasteSpecial Paste:=xlAll,
Operation:=xlNone, SkipBlanks:=True _
********, Transpose:=True
****Sheets("20040602").Select
****Range("E13:E25").Select
****Application.CutCopyMode = False
****Selection.Copy
****Sheets("Sheet3").Select
****Range("B2").Select
****Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
********True, Transpose:=True
****Sheets("20040526").Select
****Range("D5").Select
****Application.CutCopyMode = False
****Selection.Copy
****Sheets("Sheet3").Select
****Range("A3").Select
****ActiveSheet.Paste
****Sheets("20040526").Select
****Range("E13:E25").Select
****Application.CutCopyMode = False
****Selection.Copy
****Sheets("Sheet3").Select
****Range("B3").Select
****Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
********True, Transpose:=True
****Sheets("20040520").Select
****Range("D5").Select
****Application.CutCopyMode = False
****Selection.Copy
****Sheets("Sheet3").Select
****Range("A4").Select
****ActiveSheet.Paste
****Sheets("20040520").Select
****Range("E13:E25").Select
****Application.CutCopyMode = False
****Selection.Copy
****Sheets("Sheet3").Select
****Range("B4").Select
****Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
********True, Transpose:=True
****Sheets("20040331").Select
****Range("D5").Select
****Application.CutCopyMode = False
****Selection.Copy
****Range("E26").Select
****Sheets("Sheet3").Select
****Range("A5").Select
****ActiveSheet.Paste
****Sheets("20040331").Select
****Range("E13:E25").Select
****Application.CutCopyMode = False
****Selection.Copy
****Sheets("Sheet3").Select
****Range("B5").Select
****Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
********True, Transpose:=True
****Range("I1:M5").Select
****Application.CutCopyMode = False
****Selection.Delete Shift:=xlToLeft
****Range("H5").Select
End Sub


*** Sent via Devdex http://www.devdex.com ***
Don't just participate in USENET...get rewarded for it!

Ron de Bruin

Copying data from several worksheets and merging into a new worksheet
 
Try this

http://www.rondebruin.nl/copy2.htm

Look in the VBA help for Paste Special
You can transpose your data with it

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Lost" wrote in message ...
I am trying to put data that is in columns from several
worksheets into another worksheet in row form. I
recorded a macro with a few of the sheets , I have
numerous worksheets, upwards of
40, and I was hoping that someone can help me to find
a way to record the selected data from all the sheets in
the workbook without going through every worksheet. I
hope I was clear. Thank you in
advance for your help.
The recorded macro:

Sub Macro3try()
'
' Macro3try Macro
' Macro recorded 6/17/04
'

'
With ActiveWindow
.Top = 48
.Left = 19
End With
Range("D4:D5").Select
Selection.Copy
Sheets.Add
Range("A1").Select
ActiveSheet.Paste
Sheets("20040602").Select
Range("A13:A25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlAll,
Operation:=xlNone, SkipBlanks:=True _
, Transpose:=True
Sheets("20040602").Select
Range("E13:E25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
True, Transpose:=True
Sheets("20040526").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("A3").Select
ActiveSheet.Paste
Sheets("20040526").Select
Range("E13:E25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
True, Transpose:=True
Sheets("20040520").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("A4").Select
ActiveSheet.Paste
Sheets("20040520").Select
Range("E13:E25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
True, Transpose:=True
Sheets("20040331").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Range("E26").Select
Sheets("Sheet3").Select
Range("A5").Select
ActiveSheet.Paste
Sheets("20040331").Select
Range("E13:E25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
True, Transpose:=True
Range("I1:M5").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("H5").Select
End Sub


*** Sent via Devdex http://www.devdex.com ***
Don't just participate in USENET...get rewarded for it!





All times are GMT +1. The time now is 05:22 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com