-
Solved: Data from multiple sheets into one sheet?
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
-
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]
-
thanks much Jolivanes, worked like a charm
-
Glad it worked for you.
Good luck
-
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]
-
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]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules