Copying selected data from numerous worksheets into one worksheet

L

Lost

I need help copying selected data from a number of worksheets within
the same workbook and merging all the data into one worksheet, while
flipping the data so that it is horizontal at to vertical. I recorded
a macro for what I want to do, I just need to make it streamlined and
usable for many sheets without selecting each sheet. The only problem
is that I have no idea how to do that, what I've done this far was a
challenge. Thanks so much for your help.

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
 
B

Bob Greenblatt

I need help copying selected data from a number of worksheets within
the same workbook and merging all the data into one worksheet, while
flipping the data so that it is horizontal at to vertical. I recorded
a macro for what I want to do, I just need to make it streamlined and
usable for many sheets without selecting each sheet. The only problem
is that I have no idea how to do that, what I've done this far was a
challenge. Thanks so much for your help.

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
Click to expand...
Try the following. I have not tested it, so let me know if you have a
problem with it. I removed all the sheet activations and selections as they
are not necessary, but merely an artifact of the recording process. (Watch
out for the line continuations on the paste special lines, they might not
have survived the emai process properly.

Sub Macro3try()

'
' Macro3try Macro
' Macro recorded 6/17/04
'
'Modified by Bob Greenblatt 6/18/04
'
Range("D4:D5").Copy
Sheets.Add
Range("A1").Paste
With Sheets("20040602")
.Range("A13:A25").Copy
Sheets("Sheet3").Range("B1").PasteSpecial Paste:=xlAll,
Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
.Range("E13:E25").Copy
Sheets("Sheet3").Range("B2").PasteSpecial Paste:=xlValues,
Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
End With
With Sheets("20040526")
.Range("D5").Copy Sheets("Sheet3").Range("A3")
.Range("E13:E25").Copy
Sheets("Sheet3").Range("B3").PasteSpecial Paste:=xlValues,
Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
End With
With Sheets("20040520")
.Range("D5").Copy Sheets("Sheet3").Range("A4")
.Range("E13:E25").Copy
Sheets("Sheet3").Range("B4").PasteSpecial Paste:=xlValues,
Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
End With
With Sheets("20040331")
.Range("D5").Copy Sheets("Sheet3").Range("A5")
.Range("E13:E25").Copy
End With
With Sheets("Sheet3")
.Range("B5").PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
.Range("I1:M5").Delete Shift:=xlToLeft
.Range("H5").Select
End With
Application.CutCopyMode = False
End Sub
 
J

Jim Gordon MVP

Hi,

I'm not clear on what you mean by "usable for many sheets without selecting
each sheet." It would seem to me that in order to use the code on any
worksheet that the first thing you would do is to select the worksheet that
you want to work on.

Do you want to automate the code so that it cycles through all the
worksheets within the workbook?

-Jim


I need help copying selected data from a number of worksheets within
the same workbook and merging all the data into one worksheet, while
flipping the data so that it is horizontal at to vertical. I recorded
a macro for what I want to do, I just need to make it streamlined and
usable for many sheets without selecting each sheet. The only problem
is that I have no idea how to do that, what I've done this far was a
challenge. Thanks so much for your help.

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
Click to expand...

--
Jim Gordon
Mac MVP

MVPs are not Microsoft Employees
MVP info
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help merging two VBA codes 2
Macro to run on hidden sheet 4
Filename Problem In a Macro 4
Copy & paste macro for multiple worksheets 8
= Today()+1 into Sheet1, Sheet2, and Sheet3 2
Copying Solver results of each iteration to a given location in a workbook 1
Having difficulty copying and pasting on VBA 3
Trying to loop format on excel 1

Top