VBA 复制工作簿内容

Sub CopyData()

hh = MsgBox("Confirm to refresh?", vbOKCancel, "Confirm")

If hh = 1 Then

Application.ScreenUpdating = False

Dim s_wb As Workbook, t_wb As Workbook, ws2 As Worksheet

'MsgBox ("Checkpoint 1 OK")

'Check if all workbook & worksheet exists
For i = 3 To Worksheets(1).Range("A65536").End(xlUp).Row

s_filepath = Worksheets(1).Range("B" & i).Value
s_filename = Worksheets(1).Range("C" & i).Value
s_sheetname = Worksheets(1).Range("D" & i).Value
s_range = Worksheets(1).Range("E" & i).Value
t_filepath = Worksheets(1).Range("F" & i).Value
t_filename = Worksheets(1).Range("G" & i).Value
t_sheetname = Worksheets(1).Range("H" & i).Value
t_range = Worksheets(1).Range("I" & i).Value

'Check file existence
If Dir(s_filepath & "\" & s_filename) = "" Then
MsgBox ("Source document " & s_filepath & "\" & s_filename & " not exists")
Exit Sub
End If

If Dir(t_filepath & "\" & t_filename) = "" Then
MsgBox ("Target document " & t_filepath & "\" & t_filename & " not exists")
Exit Sub
End If

'Check if worksheets exists
Set s_wb = Workbooks.Open(s_filepath & "\" & s_filename)
Set t_wb = Workbooks.Open(t_filepath & "\" & t_filename)

On Error Resume Next
If s_wb.Sheets(s_sheetname) Is Nothing Then
MsgBox ("Source worksheet " & s_sheetname & " not exists")
s_wb.Close False
t_wb.Close False
Exit Sub
End If

On Error Resume Next
If t_wb.Sheets(t_sheetname) Is Nothing Then
MsgBox ("Target worksheet " & t_sheetname & " not exists")
s_wb.Close False
t_wb.Close Falses
Exit Sub
End If

s_wb.Close False
t_wb.Close False

Next i

'MsgBox ("Checkpoint 2 OK")

'Start update if files all exists
For i = 3 To Worksheets(1).Range("A65536").End(xlUp).Row

s_filepath = Worksheets(1).Range("B" & i).Value
s_filename = Worksheets(1).Range("C" & i).Value
s_sheetname = Worksheets(1).Range("D" & i).Value
s_range = Worksheets(1).Range("E" & i).Value
t_filepath = Worksheets(1).Range("F" & i).Value
t_filename = Worksheets(1).Range("G" & i).Value
t_sheetname = Worksheets(1).Range("H" & i).Value
t_range = Worksheets(1).Range("I" & i).Value

'Update worksheet raw
Set s_wb = Workbooks.Open(s_filepath & "\" & s_filename)
Set t_wb = Workbooks.Open(t_filepath & "\" & t_filename)

t_wb.Sheets(t_sheetname).Cells.ClearContents
s_wb.Sheets(s_sheetname).Cells.Copy t_wb.Sheets(t_sheetname).Range("a1")

t_wb.Save
t_wb.Close
s_wb.Close False

Next i

Set s_wb = Nothing
Set t_wb = Nothing

Application.ScreenUpdating = True
MsgBox ("Refresh is done!")

'sa = MsgBox("Save this file?", vbOKCancel, "Save")
'If sa = 1 Then
'ThisWorkbook.Save
'End If

Else
Exit Sub
End If

End Sub