Need to Import Data from Multiple Sheets into a Master Sheet

[Hotnumbers]

Need Help in writing VB that will extract data from multiple tabs in to one master tab.
Here is my Dilemma. I have a workbook with multiple tabs; this could range from 1 to 20. They are all the same structure and view.
I need to pull from each tab, Column A, B, C, D, H, and AC. Once the data is pulled from the tab I need to it tag it with the TAB name on each data it retrieved. For example if the Tab name is Movie A. I need it to tab MoveA on a separate column next to each of the rows of data to tab MoveA on a separate column next to each of the rows of data it retrieved. .

The End result should something like this. However, once the first data is imported i need the data to be import next rate under it. A loop till all the tabs have been imported. PLEASE HELP

END RESULT FILE ATTACHED.

IF source files are needed be happy to provide...

[Tinbendr]

Have you looked at this?

[mancubus]

here is something to play around with:

assumptions:
row 1 of worksheets contain column headers.
there are no merged cells.
all worksheets contain data to get copied.

[VBA]
Sub CopySomeColumnsFromAllWorksheets()
'http://www.vbaexpress.com/forum/showthread.php?t=40234

Dim ConsWs As Worksheet, ws As Worksheet
Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim LastRow As Long, calc As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

On Error Resume Next
Worksheets("Consolidate").Delete
On Error GoTo 0

Set ConsWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))
With ConsWs
.Name = "Consolidation"
.Range("A1").Value = "Worksheet Name"
.Range("B1").Value = Worksheets(1).Range("A1").Value
.Range("C1").Value = Worksheets(1).Range("B1").Value
.Range("D1").Value = Worksheets(1).Range("C1").Value
.Range("E1").Value = Worksheets(1).Range("D1").Value
.Range("F1").Value = Worksheets(1).Range("H1").Value
.Range("G1").Value = Worksheets(1).Range("AC1").Value
.Range("A1:G1").Font.Bold = True
End With

For Each ws In Worksheets
With ws
If .Index = Worksheets.Count Then Exit For
If .Name <> ConsWs.Name Then
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rng1 = .Range("A2" & LastRow)
Set Rng2 = .Range("H2:H" & LastRow)
Set Rng3 = .Range("AC2:AC" & LastRow)
ConsWs.Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(Rng1.Rows.Count, Rng1.Columns.Count).Value = Rng1.Value
ConsWs.Cells(Rows.Count, "F").End(xlUp).Offset(1).Resize(Rng2.Rows.Count).Value = Rng2.Value
ConsWs.Cells(Rows.Count, "G").End(xlUp).Offset(1).Resize(Rng3.Rows.Count).Value = Rng3.Value
ConsWs.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(Rng1.Rows.Count).Value = ws.Name
End If
End With
Next

With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = calc
End With

End Sub
[/VBA]

[Hotnumbers]

THis is EXCELLENT... Thank you. I will give it a try... will keep you posted...

[Hotnumbers]

I AM SO HAPPY I AM ABOUT TO CRY... THIS IS THE COOLEST THING... THANKS A MILLIONNN !!!!!!!!!!!!!!!!!!!!!!!!!

[Hotnumbers]

i need to tweek it just a small amount. but 99% of it works... even better than i invesioned...

YOU ARE A LIFE SAVER....

[Hotnumbers]

Two QUick Quesitons.

One: I have a work sheet called Menu. How do i precent it from being conslidated.

Two: How do i have it check if the Conslidate sheet is there. Delete it and generate a new one.

[mancubus]

you're wellcome.

[VBA]
Sub CopySomeColumnsFromAllWorksheets()
'http://www.vbaexpress.com/forum/showthread.php?t=40234

Dim ConsWs As Worksheet, ws As Worksheet
Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim LastRow As Long, calc As Long, LastBlank As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

On Error Resume Next
Worksheets("Consolidation").Delete
On Error GoTo 0

Set ws = Worksheets("MovieA") 'any worksheet name with data to merge
Set ConsWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))
With ConsWs
.Name = "Consolidation"
.Range("A1").Value = "Worksheet Name"
.Range("B1").Value = ws.Range("A1").Value
.Range("C1").Value = ws.Range("B1").Value
.Range("D1").Value = ws.Range("C1").Value
.Range("E1").Value = ws.Range("D1").Value
.Range("F1").Value = ws.Range("H1").Value
.Range("G1").Value = ws.Range("AC1").Value
.Range("A1:G1").Font.Bold = True
End With

For Each ws In Worksheets
With ws
If .Index = Worksheets.Count Then Exit For
If .Name <> ConsWs.Name And .Name <> "Menu" Then
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rng1 = .Range("A2" & LastRow)
Set Rng2 = .Range("H2:H" & LastRow)
Set Rng3 = .Range("AC2:AC" & LastRow)
With ConsWs
LastBlank = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1
.Cells(LastBlank, "B").Resize(Rng1.Rows.Count, Rng1.Columns.Count).Value = Rng1.Value
.Cells(LastBlank, "F").Resize(Rng2.Rows.Count, Rng2.Columns.Count).Value = Rng2.Value
.Cells(LastBlank, "G").Resize(Rng3.Rows.Count, Rng3.Columns.Count).Value = Rng3.Value
.Cells(LastBlank, "A").Resize(Rng1.Rows.Count, 1).Value = ws.Name '1 for 1 column width = column A
End With
End If
End With
Next

With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = calc
End With

End Sub
[/VBA]

[mancubus]

for the second question:

this bit of the code:
[VBA]
On Error Resume Next
Worksheets("Consolidation").Delete
On Error Goto 0
[/VBA]

deletes the worksheet named "Consolidation" if exists. if not exits then skips to next line.
so you don't need to check if "Consolidation" exists.

[mancubus]

btw, there are numerous methods to test the presence of a worksheet.
you can find in the forums.

[VBA]For Each ws In Worksheets
If ws.Name Like "Consolidation*" Then
ws.Delete
Exit For
End if
Next
[/VBA]

this is a udf:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=187