Solved: Data from multiple sheets into one sheet?

[eversharp]

I have a workbook with over 100 tabs... the tabs are identical other than the date and the data within... for example there is a sheet/tab for 2-2-2012, another for 2-3-2012, and so forth.

I want to run a macro that would go through each sheet and copy specific cells to a new "summary sheet"

The data in each individual sheet looks like this (in columns D, E, and F):

DATE TYPE AMOUNT

2-1-2012 X $2,492
2-1-2012 Y $4,102

Then the next sheet would look the same:

DATE TYPE AMOUNT

2-2-2012 X $1,494
2-2-2012 Y $3,104


I want to run a macro to produce a summary sheet that looks like this:

2-1-2012 X $2,492
2-1-2012 Y $4,102
2-2-2012 X $1,494
2-2-2012 Y $3,104

and so on

Any help with syntax would be great. I tried to record a macro but couldn't get it to work for more than one sheet.

I think my psuedo-code would be something like:

for each sheet in workbook,
copy cells D1, D2, E1, E2, F1, F2
to the next available row in a sheet called 'SUMMARY'


Appreciate any insight

[jolivanes]

Something like this?

[VBA]
Sub Combine()
Dim destSH As Worksheet, sh As Worksheet
Dim rw As Long
Application.ScreenUpdating = False
Set destSH = Worksheets.Add(After:=Worksheets(Worksheets.Count))
destSH.Name = "Summary" '<----- This will add a sheet named "Summary".
rw = 2
For Each sh In Worksheets
If sh.Name <> destSH.Name Then
sh.Range("D1:F2").Copy
With destSH.Cells(rw, 1)
.PasteSpecial Paste:=xlPasteValues
End With
rw = rw + 2
End If
Next sh
Application.ScreenUpdating = True
End Sub

[/VBA]

[eversharp]

thanks much Jolivanes, worked like a charm

[jolivanes]

Glad it worked for you.
Good luck

[jolivanes]

To prevent getting an error message that a Sheet called "Summary" exist already, you could change the previous supplied code to the following.

[VBA]Function wsExists(wksName As String) As Boolean
On Error Resume Next
wsExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function[/VBA]


[VBA]
Sub Combine()
Dim destSH As Worksheet, sh As Worksheet
Dim rw As Long
Application.DisplayAlerts = False
If wsExists("Summary") Then
Sheets("Summary").Delete
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = False
Set destSH = Worksheets.Add(After:=Worksheets(Worksheets.Count))
destSH.Name = "Summary" '<----- This will add a sheet named "Summary".
rw = 2
For Each sh In Worksheets
If sh.Name <> destSH.Name Then
sh.Range("D1:F2").Copy
With destSH.Cells(rw, 1)
.PasteSpecial Paste:=xlPasteValues
End With
rw = rw + 2
End If
Next sh
Application.ScreenUpdating = True
End Sub
[/VBA]

[snb]

or

[VBA]Sub snb()
Sheets.Add.Name = "summary"

For Each sh In Sheets
If sh.Name <> "summary" Then Sheets("summary").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(2, 3) = sh.Range("D1:F2").Value
Next
End Sub[/VBA]