|
これでどうでしょう?
Public Sub Test3()
Dim wkbWrite As Workbook
Set wkbWrite = Workbooks.Open(ThisWorkbook.Path & "\" & "DB.xls")
With wkbWrite.Sheets("DataBase")
.Rows("3:3").Insert Shift:=xlDown
.Rows("3:3").Interior.ColorIndex = xlNone
.Range("C3").Value = ThisWorkbook.Worksheets("1001").Range("A1").Value & _
" " & ThisWorkbook.Worksheets("1001").Range("B1").Value
End With
wkbWrite.Close SaveChanges:=True
End Sub
Public Sub Test4()
Dim wkbWrite As Workbook
Dim Ws As Worksheet
Set Ws = ThisWorkbook.Worksheets("1005")
Set wkbWrite = Workbooks.Open(ThisWorkbook.Path & "\" & "DB.xls")
wkbWrite.Sheets("DataBase").Cells.Copy Destination:=Ws.Range("A1")
End Sub
これでもチラつきが気になるようなら、
下記のコードをお試しください。
Public Sub Test5()
Dim wkbWrite As Workbook
Application.ScreenUpdating = False
Set wkbWrite = Workbooks.Open(ThisWorkbook.Path & "\" & "DB.xls")
With wkbWrite.Sheets("DataBase")
.Rows("3:3").Insert Shift:=xlDown
.Rows("3:3").Interior.ColorIndex = xlNone
.Range("C3").Value = ThisWorkbook.Worksheets("1001").Range("A1").Value & _
" " & ThisWorkbook.Worksheets("1001").Range("B1").Value
End With
wkbWrite.Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub
Public Sub Test6()
Dim wkbWrite As Workbook
Dim Ws As Worksheet
Application.ScreenUpdating = False
Set Ws = ThisWorkbook.Worksheets("1005")
Set wkbWrite = Workbooks.Open(ThisWorkbook.Path & "\" & "DB.xls")
wkbWrite.Sheets("DataBase").Cells.Copy Destination:=Ws.Range("A1")
Application.ScreenUpdating = True
End Sub
|
|