Macro Help

[needhelpinvb]

Hey Guys,

I need help in the modifying the code below to reflect 2 things; 1) only to open worksheet two and not look thru all the worksheets in a given workbook.

And 2) to choose header from row A2: and on, not from A1. Because there are two headers A1 and A2 rows have headers, but only A2 row is the header. I want it to change it so it can only copy the header first and then copy the data starting from A3 row and on.

I'm not able to post the code here because I don't have any post yet. but the name of the Code is "Combine All Data From All Worksheets in All Workbooks in a Specific Directory"


Please reply ASAP. Thanks in advance.

[Bob Phillips]

Without the code, we are not able to help.

[needhelpinvb]

no worries, i'll try to post the code ASAP.

[needhelpinvb]

Please see the code below:
Option Explicit

[VBA]Sub CombineSheetsFromAllFilesInADirectory()
Dim Path As String 'string variable to hold the path to look through
Dim FileName As String 'temporary filename string variable
Dim tWB As Workbook 'temporary workbook (each in directory)
Dim tWS As Worksheet 'temporary worksheet variable
Dim mWB As Workbook 'master workbook
Dim aWS As Worksheet 'active sheet in master workbook
Dim RowCount As Long 'Rows used on master sheet
Dim uRange As Range 'usedrange for each temporary sheet

'***** Set folder to cycle through *****
Path = ThisWorkbook.Path & "\subdirectory\" 'Change as needed, ie "C:\"
Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating
Set mWB = Workbooks.Add(1) 'create a new one-worksheet workbook
Set aWS = mWB.ActiveSheet 'set active sheet variable to only sheet in mWB
If Right(Path, 1) <> Application.PathSeparator Then 'if path doesnt end in "\"
Path = Path & Application.PathSeparator 'add "\"
End If
FileName = Dir(Path & "*.xls", vbNormal) 'set first file's name to filename variable
Do Until FileName = "" 'loop until all files have been parsed
If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable
For Each tWS In tWB.Worksheets 'loop through each sheet
Set uRange = tWS.Range("A2", tWS.Cells(tWS.UsedRange.Row + tWS.UsedRange.Rows _
.Count - 1, tWS.UsedRange.Column + tWS.UsedRange.Columns.Count - 1)) 'set used range
If RowCount + uRange.Rows.Count > 65536 Then 'if the used range wont fit on the sheet
aWS.Columns.AutoFit 'autofit mostly-used worksheet's columns
Set aWS = mWB.Sheets.Add(After:=aWS) 'add a new sheet that will accommodate data
RowCount = 0 'reset RowCount variable
End If
If RowCount = 0 Then 'if working with a new sheet
aWS.Range("A1", aWS.Cells(1, uRange.Columns.Count)).Value = _
tWS.Range("A1", tWS.Cells(1, uRange.Columns.Count)).Value 'copy headers from tWS
RowCount = 1 'add one to rowcount
End If
aWS.Range("A" & RowCount + 1).Resize(uRange.Rows.Count, uRange.Columns.Count).Value _
= uRange.Value 'move data from temp sheet to data sheet
RowCount = RowCount + uRange.Rows.Count 'increase rowcount accordingly
Next 'tWS
tWB.Close False 'close temporary workbook without saving
End If
FileName = Dir() 'set next file's name to FileName variable
Loop
aWS.Columns.AutoFit 'autofit columns on last data sheet
mWB.Sheets(1).Select 'select first data sheet on master workbook
Application.EnableEvents = True 're-enable events
Application.ScreenUpdating = True 'turn screen updating back on

'Clear memory of the object variables
Set tWB = Nothing
Set tWS = Nothing
Set mWB = Nothing
Set aWS = Nothing
Set uRange = Nothing
End Sub[/VBA]

[needhelpinvb]

Please respond, as I need to run this asap.

[Bob Phillips]

Untested

[VBA]Sub CombineSheetsFromAllFilesInADirectory()
Dim Path As String 'string variable to hold the path to look through
Dim FileName As String 'temporary filename string variable
Dim tWB As Workbook 'temporary workbook (each in directory)
Dim tWS As Worksheet 'temporary worksheet variable
Dim mWB As Workbook 'master workbook
Dim aWS As Worksheet 'active sheet in master workbook
Dim RowCount As Long 'Rows used on master sheet
Dim uRange As Range 'usedrange for each temporary sheet

'***** Set folder to cycle through *****
Path = ThisWorkbook.Path & "\subdirectory\" 'Change as needed, ie "C:\"
Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating
Set mWB = Workbooks.Add(1) 'create a new one-worksheet workbook
Set aWS = mWB.ActiveSheet 'set active sheet variable to only sheet in mWB

If Right(Path, 1) <> Application.PathSeparator Then 'if path doesnt end in "\"

Path = Path & Application.PathSeparator 'add "\"
End If

FileName = Dir(Path & "*.xls", vbNormal) 'set first file's name to filename variable
Do Until FileName = "" 'loop until all files have been parsed

If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then

Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable
Set tWS = tWB.Worksheets(2)

Set uRange = tWS.Range("A2", tWS.Cells(tWS.UsedRange.Row + tWS.UsedRange.Rows _
.Count - 1, tWS.UsedRange.Column + tWS.UsedRange.Columns.Count - 1)) 'set used range

If RowCount + uRange.Rows.Count > 65536 Then 'if the used range wont fit on the sheet

aWS.Columns.AutoFit 'autofit mostly-used worksheet's columns
Set aWS = mWB.Sheets.Add(After:=aWS) 'add a new sheet that will accommodate data
RowCount = 0 'reset RowCount variable
End If

If RowCount = 0 Then 'if working with a new sheet

aWS.Range("A1", aWS.Cells(1, uRange.Columns.Count)).Value = _
tWS.Range("A2", tWS.Cells(1, uRange.Columns.Count)).Value 'copy headers from tWS
RowCount = 1 'add one to rowcount
End If

aWS.Range("A" & RowCount + 1).Resize(uRange.Rows.Count, uRange.Columns.Count).Value _
= uRange.Value 'move data from temp sheet to data sheet
RowCount = RowCount + uRange.Rows.Count 'increase rowcount accordingly

tWB.Close False 'close temporary workbook without saving
End If

FileName = Dir() 'set next file's name to FileName variable
Loop

aWS.Columns.AutoFit 'autofit columns on last data sheet
mWB.Sheets(1).Select 'select first data sheet on master workbook

Application.EnableEvents = True 're-enable events
Application.ScreenUpdating = True 'turn screen updating back on

'Clear memory of the object variables
Set tWB = Nothing
Set tWS = Nothing
Set mWB = Nothing
Set aWS = Nothing
Set uRange = Nothing
End Sub
[/VBA]

[needhelpinvb]

Thank you for your help, however what do I change in the code below to select the worksheet that is named "Need Info".

Untested

[VBA]Sub CombineSheetsFromAllFilesInADirectory()
Dim Path As String 'string variable to hold the path to look through
Dim FileName As String 'temporary filename string variable
Dim tWB As Workbook 'temporary workbook (each in directory)
Dim tWS As Worksheet 'temporary worksheet variable
Dim mWB As Workbook 'master workbook
Dim aWS As Worksheet 'active sheet in master workbook
Dim RowCount As Long 'Rows used on master sheet
Dim uRange As Range 'usedrange for each temporary sheet

'***** Set folder to cycle through *****
Path = ThisWorkbook.Path & "\subdirectory\" 'Change as needed, ie "C:\"
Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating
Set mWB = Workbooks.Add(1) 'create a new one-worksheet workbook
Set aWS = mWB.ActiveSheet 'set active sheet variable to only sheet in mWB

If Right(Path, 1) <> Application.PathSeparator Then 'if path doesnt end in "\"

Path = Path & Application.PathSeparator 'add "\"
End If

FileName = Dir(Path & "*.xls", vbNormal) 'set first file's name to filename variable
Do Until FileName = "" 'loop until all files have been parsed

If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then

Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable
Set tWS = tWB.Worksheets(2)

Set uRange = tWS.Range("A2", tWS.Cells(tWS.UsedRange.Row + tWS.UsedRange.Rows _
.Count - 1, tWS.UsedRange.Column + tWS.UsedRange.Columns.Count - 1)) 'set used range

If RowCount + uRange.Rows.Count > 65536 Then 'if the used range wont fit on the sheet

aWS.Columns.AutoFit 'autofit mostly-used worksheet's columns
Set aWS = mWB.Sheets.Add(After:=aWS) 'add a new sheet that will accommodate data
RowCount = 0 'reset RowCount variable
End If

If RowCount = 0 Then 'if working with a new sheet

aWS.Range("A1", aWS.Cells(1, uRange.Columns.Count)).Value = _
tWS.Range("A2", tWS.Cells(1, uRange.Columns.Count)).Value 'copy headers from tWS
RowCount = 1 'add one to rowcount
End If

aWS.Range("A" & RowCount + 1).Resize(uRange.Rows.Count, uRange.Columns.Count).Value _
= uRange.Value 'move data from temp sheet to data sheet
RowCount = RowCount + uRange.Rows.Count 'increase rowcount accordingly

tWB.Close False 'close temporary workbook without saving
End If

FileName = Dir() 'set next file's name to FileName variable
Loop

aWS.Columns.AutoFit 'autofit columns on last data sheet
mWB.Sheets(1).Select 'select first data sheet on master workbook

Application.EnableEvents = True 're-enable events
Application.ScreenUpdating = True 'turn screen updating back on

'Clear memory of the object variables
Set tWB = Nothing
Set tWS = Nothing
Set mWB = Nothing
Set aWS = Nothing
Set uRange = Nothing
End Sub
[/VBA]

[Aussiebear]

Try changing the line
[VBA]
Set tWB = tWB.Worksheets(2)
[/VBA]

to

[vba] Set tWB = tWB.Worksheets("Need Info")[/vba]

and see what happens