raikayovbaのブログ

raikayovbaのブログ

ブログの説明を入力します。

Amebaでブログを始めよう!

Sub sample2()
Dim xlApp As Object '見えないエクセル用
Dim xlAppfrom As Object '見えないエクセル用
Dim wb As Workbook '見えないブック用
Dim wbfrom As Workbook '見えないブック用
Dim ws(1) As Worksheet '両方のシート用
Dim wbName As String 'コピー先ブックのパス&ファイル名称
Dim wbNamefrom As String 'コピー元ブックのパス&ファイル名称

'On Error GoTo errorHandler 'エラー処理へ飛ぶ

wbNamefrom = "C:\Users\kaihatu\Documents\sample0121.xls"
wbName = "C:\Users\kaihatu\Documents\sample0121.xlsx"

Set xlAppfrom = CreateObject("Excel.Application")
Set wbfrom = xlAppfrom.Workbooks.Open(wbNamefrom) 'コピー元ブックを開く
Set ws(0) = wbfrom.Worksheets(1) 'コピー元のシート

ws(0).Range("A8:G14").Copy

Set xlApp = CreateObject("Excel.Application")
'xlApp.Visible = True '見えないエクセルにする(必要ないかも)
'xlApp.DisplayAlerts = False 'アプリケーションメッセージを無効にする

Set wb = xlApp.Workbooks.Open(wbName) 'コピー先ブックを開く
Set ws(1) = wb.Worksheets(1) 'コピー先のシート

'ws(1).Range("A8:G14").Value = ws(0).Range("A8:G14").Value '値のコピー


wb.Activate
wb.Worksheets(1).Activate
wb.Worksheets(1).Range("A8").Select

wb.Worksheets(1).Paste




wb.Save 'コピー先ブックを保存
wb.Close 'コピー先ブックを閉じる

'xlApp.DisplayAlerts = True 'アプリケーションメッセージを無効にする(念のため)

'errorHandler:
'On Error Resume Next 'エラー無効
'xlApp.Quit '見えないエクセル終了
'Set xlApp = Nothing '変数解放
'If Err.Number = 0 Then
'MsgBox "正常に終了しました"
'Else
'MsgBox "エラーで終了しました" & vbLf & _
'Err.Number & vbLf & _
'Err.Description
'End If
Set xlApp = Nothing
Set xlAppfrom = Nothing '見えないエクセル用


End Sub