Data conversion

  • Thread starter Thread starter Gord
  • Start date Start date
G

Gord

I have a simple multi-sheets workbook and I want to convert all its
data to a database file or a single sheet.

The file look like this:

[Sheet 1] start at cell A1
Account Amount
01-0011 300
01-0012 2000
01-0013 50200
....
01-0188 3900

[Sheet 2] start at cell A1
Account Amount
02-0011 1000
02-0012 4000
02-0013 8200
....
02-0188 1200

I have a total of 160 sheets of the same format.

Is there an easy way to convert to a single sheet as shown?
Account Amount
01-0011 300
01-0012 2000
01-0013 50200
....
01-0188 3900
02-0011 1000
02-0012 4000
02-0013 8200
....
02-0188 1200
....


Thanks in advance.

Gord.
 
Hi Gord
Try this code

Sub CollectMyData()
'
' CollectMyData Macro
' Macro recorded 2003/12/30 by Mark
On Error GoTo CopyMyData
Sheets(Sheet1).Select
Range("A2").Select
ActiveCell.CurrentRegion.Select
Selection.Copy
Sheets("AllRecords").Select
Range("A1").Select
ActiveSheet.Paste

For i = 1 To 160 '
MySheet = "Sheet" & i
Sheets(MySheet).Select
Rows(1).Select
Selection.Delete
Next i


CopyMyData:
On Error GoTo ErrHandler
For i = 2 To 160 '
MySheet = "Sheet" & i
Sheets(MySheet).Select
Range("A2").Select
ActiveCell.CurrentRegion.Select
Selection.Copy
Sheets("AllRecords").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Next i

ErrHandler:
MyOk = MsgBox("All data copied to the target worksheet", vbOKOnly)
Err.Number = 0

End Sub
 
I'm sure your code will work. For a more generalized and streamlined
solution, try the code below. Its advantages include: no modification
of the existing worksheets, no dependence on their names, no activating
/ selecting worksheets / cells, enforce copying of only values, and
some minimal verification of the source worksheet's content.

Option Explicit

Sub initialize(ByRef srcWB As Workbook, _
ByRef newWS As Worksheet)
Set srcWB = ActiveWorkbook
Set newWS = Application.Workbooks.Add.Worksheets.Add
newWS.Range("a1") = "Account"
newWS.Range("b1") = "Amount"
End Sub
Sub CollectMyData()
Dim srcWB As Workbook, newWS As Worksheet, _
aWS As Worksheet, SrcRng As Range
On Error GoTo errXIT
initialize srcWB, newWS
For Each aWS In srcWB.Worksheets
If aWS.Range("a1") = "Account" Then
Set SrcRng = aWS.Range("a1").CurrentRegion
Set SrcRng = SrcRng.Offset(1, 0).Resize(SrcRng.Rows.Count - 1)
SrcRng.Copy
newWS.Cells(Rows.Count, 1).End(xlUp) _
.Offset(1, 0).PasteSpecial xlPasteValues
End If
Next aWS
Exit Sub
errXIT:
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
End Sub


--
Regards,

Tushar Mehta, MS MVP -- Excel
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions
 
Back
Top