在Excel表格中同步数据

lss001

'提示：把以下代码放置在Sheet1模块中，
'Sheet2将同步Sheet1中的数据！


'同步指定单元格
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sourceSheet As Worksheet, targetSheet As Worksheet
Dim syncCell As String
'指定表格
Set sourceSheet = Sheet1
Set targetSheet = Sheet2
syncCell = "A1" '指定单元格

'同步数据
If Target.Address = Range(syncCell).Address Then
targetSheet.Range(Target.Address) = sourceSheet.Range(Target.Address)
End If

'同步格式
If Target.Address = Range(syncCell).Address Then
sourceSheet.Range(Target.Address).Copy
targetSheet.Range(Target.Address).PasteSpecial xlPasteAll
End If

'同步公式
If Target.Address = Range(syncCell).Address Then
sourceSheet.Range(Target.Address).Copy
targetSheet.Range(Target.Address).PasteSpecial xlPasteFormulasAndNumberFormats
End If
End Sub


'同步指定行或列
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sourceSheet As Worksheet, targetSheet As Worksheet
Dim syncRow As Long
'指定表格
Set sourceSheet = Sheet1
Set targetSheet = Sheet2
'指定行或列
syncRow = 1
'或syncColumn = 1

If Target.Row = syncRow Then
'或Target.Column = syncColumn Then
targetSheet.Range(Target.Address) = sourceSheet.Range(Target.Address)
End If
End Sub


'同步指定区域
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sourceSheet As Worksheet, targetSheet As Worksheet
Dim syncRange As String
Dim isInRange
'指定表格
Set sourceSheet = Sheet1
Set targetSheet = Sheet2
syncRange = "A1:C5" '指定区域

Set isInRange = Application.Intersect(Target, Range(syncRange))
If isInRange Is Nothing Then
targetSheet.Range(Target.Address) = sourceSheet.Range(Target.Address)
End If
End Sub