It is easy to synchronize Sheets in 2 WorkBooks
Consider 2 WorkBook WB1 and WB2 on 2 PC. There are 2 same Sheets in each one.
1. Create a DB.mdb with Table1 and Table2 on Server or shared folder
2. Convert data from WB1.Sheet1 to Table1 of DB.mdb
3. Convert data from Table1 to Sheet2
and do similarly whith WB2.Sheet2
Use the following LetMDB to convert XLS to MDB and GetMDB to convert MDB to XLS
[vba]Public Sub LetMDB(Sh As Object, FileName$, TableName$)
Dim i As Long, j As Integer, lastRow As Long
lastRow = xdLastRow(Sh, NUM_ROWS_XLS)
'-------------------------------
Dim strConect$, RS As Object
On Error GoTo sthWrong
strConect = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & FileName & ";"
Set RS = CreateObject("adodb.recordset")
RS.Open "DELETE * FROM " & TableName, strConect, 0, 2, 1
RS.Open "SELECT * FROM " & TableName, strConect, 0, 2, 1
With Sh
For i = 1 To lastRow
RS.AddNew
If Application.CountA(.Cells(i, 1).EntireRow) > 0 Then
For j = 1 To NUM_FIELDS_MDB
If Cells.Item(i, j) <> vbNullString Then
RS.Fields(j - 1) = .Cells.Item(i, j) '.FormulaR1C1
End If
Next j
End If
RS.Update
Next
RS.Close
End With
Set RS = Nothing
End Sub
Public Sub GetMDB(Sh As Object, FileName$, TableName$)
Application.ScreenUpdating = False
Dim i As Long, j As Integer
Dim strConect$, RS As Object
strConect = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & FileName & ";"
Set RS = CreateObject("adodb.recordset")
RS.Open "SELECT * FROM " & TableName, strConect, 0, 1, 1
With RS
If Not .EOF Then
.MoveFirst
i = 1
Sh.Cells.ClearContents 'clear old data in sh
Do Until .EOF
For j = 0 To NUM_FIELDS_MDB - 1
If Not IsNull(.Fields(j)) Then
Sh.Cells.Item(i, j + 1).FormulaR1C1 = CStr(.Fields(j))
End If
Next
.MoveNext
i = i + 1
Loop
End If
.Close
End With
Set RS = Nothing
Application.ScreenUpdating = True
End Sub[/vba]
Reply With Quote