Copying a column from several similar sheets into one sheet

L

Lost

I have several worksheets in one workbook and I want to merge/copy one
column from each worksheet (the same column)
(Like this, just imagine more columns with more data on several
worksheets

Date 06052003
Actual 13
FMT 12
% 87 )

and put these columns into rows so that each worksheet's data will
descend vertically
(EX: Date Actual FMT %
06052003 13 12 87
06062003 12 15 89
06072003 11 17 90
That's what I want, Please help me to do it.
 
M

mudraker

Lost

If I understand your problem correctly this macro should help you


It assums your data is in column A
It assumes no blank rows and you data format is repeated every 4th row

It pastes meged data into column B

Sub MergeData()
Dim wS As Worksheet
Dim lRow As Long

Dim sTxt As String


Dim wS As Worksheet
Dim lRow As Long
Dim l As Long
Dim sTxt As String


For Each wS In Worksheets
For lRow = 1 To wS.Cells.Find(what:="*", _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row Step 4

sTxt$ = Mid(Cells(lRow, "a").Value, 5)
sTxt$ = sTxt & " " _
& Mid(Cells(lRow + 1, "a").Value, 7)
sTxt$ = sTxt & " " _
& Mid(Cells(lRow + 2, "a").Value, 4)
sTxt$ = sTxt & " " _
& Mid(Cells(lRow + 3, "a").Value, 2)

l = Range("b" & Rows.Count).End(xlUp).Row + 1
Cells(l, "b").Value = sTxt
Next lRow
Next wS
End Su
 
V

Vasant Nanavati

Why don't you record a macro and post it? Then I'm sure someone can help you
tro streamline the code. To paste the columns in row format, use Edit |
Paste Special | Transpose.
 
L

Lost

Thanks for the help. I tried the macro, but it doesn't
work because the assumptions made were false, sorry
that I mislead you about the program. I did record a
macro of what i need to do. I only recorded for 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 enough this time. 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!
 
Top