Combining multiple worksheets WITHOUT the same arrangement.

[turtsmurt]

Can anyone please suggest the best way for me to combine 100 worksheets into a master sheet if the information is NOT in the same format in every sheet? I was given all of this information as text and converted it to Excel in order to analyze.

I am trying to combined all 100 sheets into 1 master sheet so that I can use a Pivot table with these column headings, Year, Month, District, Location Number, Count of Notices...

Here is an example of my worksheets...

This is the information in one of the worksheets...

DISTRICT0100Location1/20102/20103/20104/20105/20106/20107/20108/20109/201010/201011/201012/20100141533550330131938521414388142111062135301011111451311437231575416431218111920131711

Here is another worksheet....

DISTRICT0700Location1/20102/20103/20104/20105/20106/20108/20109/201001136610317117219611569316306411214111132411433311521216641712181119917221

Here is another one...


DISTRICT
1700Location1/20102/20103/20104/20105/20106/20107/20108/20109/201010/201011/201012/201001956079603446499561360241134184611064236502309111442131848147122815141815216105211832119412734101
Thanks in advance,
Christine

[lucas]

Try this. It will combine all sheets in a workbook to a new worksheet:

[VBA]Sub Combine_Sheets()
Dim wshTemp As Worksheet, wsh As Worksheet
Dim rngArr() As Range, c As Range
Dim i As Integer
Dim j As Integer
ReDim rngArr(1 To 1)
For Each wsh In ActiveWorkbook.Worksheets
i = i + 1
If i > 1 Then ' resize array
ReDim Preserve rngArr(1 To i)
End If
On Error Resume Next
Set c = wsh.Cells.SpecialCells(xlCellTypeLastCell)
If Err = 0 Then
On Error GoTo 0
'Prevent empty rows
Do While Application.CountA(c.EntireRow) = 0 _
And c.EntireRow.Row > 1
Set c = c.Offset(-1, 0)
Loop
Set rngArr(i) = wsh.Range(wsh.Range("A1"), c)
End If
Next wsh
'Add temp.Worksheet
Set wshTemp = Sheets.Add(after:=Worksheets(Worksheets.Count))
On Error Resume Next
With wshTemp
For i = 1 To UBound(rngArr)
If i = 1 Then
Set c = .Range("A1")
Else
Set c = _
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
Set c = c.Offset(2, 0).End(xlToLeft) ' skip one row
End If
'Copy-paste range (prevent empty range)
If Application.CountA(rngArr(i)) > 0 Then
rngArr(i).Copy c
End If
Next i
End With
On Error GoTo 0
Application.CutCopyMode = False ' prevent marquies
With ActiveSheet.PageSetup ' Fit to 1 page
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

End Sub
[/VBA]