Merge Excel Sheets Using VBA - vba

Question

I have a Excel Sheet(Say OG.xls) which has some data already in it with some 5000 rows with headings in the first row and Upto "AN" Columns.
This No of rows(5000) doesn't change for a whole year.
Now i have 5 XL files(Say A,B,C,D,E) and the data from these files has to be appended to this OG file just starting from 5001st row every time.
All these 5 files has different no of columns but identical to that of OG File.
I have to pull data from these files and place them in OG File.
From File A : Column A,B,C,D,E,F,G&H goes to Column F,G,T,U,V,W,X&Y Of OG.xls File.
Likewise the other files data has to be extracted according to the corresponding column with OG.xls
The second file data has to be appended right below the next row where the File A ends.(Say after filling the data from File A now the OG.xls has 5110 rows,
the File B data has to filled from 5111 st row of OG.xls.
The same follows for the other files too.
The data of these 5 files has to be filled row after row but should match the columns to that of OG.xls
Each time the same operation is repeated by filling the data from 5001st row of OG.xls. For convenience we can have all these files in a same folder.
How can we do this.
Please help me in this!!!
Also let me know for any clarifications.

Answer 1

If you need a more presice answer, you would need to try something first and then ask for help in area you have got stuck. My suggestion is you begin by;
1. Start writing a VBA script in OG.XLS, as a first step try to access the file A.xls and reading the columns and pasting them (they can initially be at any location in any order).
2. Once you are able to do this, next step is to see if you put the data in right column (say 5000 in your example) by setting up right kind of variables and using them and incrementing them.
3. Your next step should be to to read the column headings in A.XLS and finding them OG.XLS and identifying them. Initially you can begin by doing a simple string comparision, later you can refine this to do a VLOOKUP.
4. During this process, if you encounter any specific problem, raise it so that you will get a better answer.
Few from the community would go to the extent of writing the entire code for you.

Answer 2

Why does Column A end up in Column F, and why does C end up in T? Is there a rule around this such as the first row is a header with with the same text in it?
Maybe a picture might help.
Based on what i can guess, i'd throw each sheet into a RecordSet with meaningful field names (you'll need to reference Microsoft ActiveX Data Objects 2.8 Library) . Once done it will be very easy to append each RecordSet and throw them into a single sheet.
You'll need to be able to find the last column and last row in each sheet to do this cleanly so have a look at How can i find the last row...
Edit...
Below is a cleaned up example of how you could do what you need in VBA. The devil is in the details such as empty sheets, and how to handle formulas (this ignores them completely), and how to merge you columns in an appropriate way (again ignored).
This has been tested in Excel 2007.
Option Explicit
Const MAX_CHARS = 1200
Sub MergeAllSheets()
Dim rs As Recordset
Dim mergedRS As Recordset
Dim sh As Worksheet
Dim wb As Workbook
Dim fieldList As New Collection
Dim rsetList As New Collection
Dim f As Variant
Dim cols As Long
Dim rows As Long
Dim c As Long
Dim r As Long
Dim ref As String
Dim fldName As String
Dim sourceColumn As String
Set wb = ActiveWorkbook
For Each sh In wb.Worksheets
Set rs = New Recordset
ref = FindEndCell(sh)
cols = sh.Range(ref).Column
rows = sh.Range(ref).Row
If ref <> "$A$1" Or sh.Range(ref).Value <> "" Then '' This is to catch empty sheet
c = 1
r = 1
Do While c <= cols
fldName = sh.Cells(r, c).Value
rs.Fields.Append fldName, adVarChar, MAX_CHARS
If Not InCollection(fieldList, fldName) Then
fieldList.Add fldName, fldName
End If
c = c + 1
Loop
rs.Open
r = 2
Do While r <= rows
rs.AddNew
c = 1
Do While c <= cols
rs.Fields(c - 1) = CStr(sh.Cells(r, c).Value)
c = c + 1
Loop
r = r + 1
Debug.Print sh.Name & ": " & r & " of " & rows & ", " & c & " of " & cols
Loop
rsetList.Add rs, sh.Name
End If
Next
Set mergedRS = New Recordset
c = 1
sourceColumn = "SourceSheet"
Do While InCollection(fieldList, sourceColumn) '' Just in case you merge a merged sheet
sourceColumn = "SourceSheet" & c
c = c + 1
Loop
mergedRS.Fields.Append sourceColumn, adVarChar, MAX_CHARS
For Each f In fieldList
mergedRS.Fields.Append CStr(f), adVarChar, MAX_CHARS
Next
mergedRS.Open
c = 1
For Each rs In rsetList
If rs.RecordCount >= 1 Then
rs.MoveFirst
Do Until rs.EOF
mergedRS.AddNew
mergedRS.Fields(sourceColumn) = "Sheet No. " & c
For Each f In rs.Fields
mergedRS.Fields(f.Name) = f.Value
Next
rs.MoveNext
Loop
End If
c = c + 1
Next
Set sh = wb.Worksheets.Add
mergedRS.MoveFirst
r = 1
c = 1
For Each f In mergedRS.Fields
sh.Cells(r, c).Formula = f.Name
c = c + 1
Next
r = 2
Do Until mergedRS.EOF
c = 1
For Each f In mergedRS.Fields
sh.Cells(r, c).Value = f.Value
c = c + 1
Next
r = r + 1
mergedRS.MoveNext
Loop
End Sub
Public Function InCollection(col As Collection, key As String) As Boolean
Dim var As Variant
Dim errNumber As Long
InCollection = False
Set var = Nothing
Err.Clear
On Error Resume Next
var = col.Item(key)
errNumber = CLng(Err.Number)
On Error GoTo 0
'5 is not in, 0 and 438 represent incollection
If errNumber = 5 Then ' it is 5 if not in collection
InCollection = False
Else
InCollection = True
End If
End Function
Public Function FindEndCell(sh As Worksheet) As String
Dim cols As Long
Dim rows As Long
Dim maxCols As Long
Dim maxRows As Long
Dim c As Long
Dim r As Long
maxRows = sh.rows.Count
maxCols = sh.Columns.Count
cols = sh.Range("A1").End(xlToRight).Column
If cols >= maxCols Then
cols = 1
End If
c = 1
Do While c <= cols
r = sh.Cells(1, c).End(xlDown).Row
If r >= maxRows Then
r = 1
End If
If r > rows Then
rows = r
End If
c = c + 1
Loop
FindEndCell = sh.Cells(rows, cols).Address
End Function