Excel-VBA セルのデータ書出しについて質問

質問

• Excel-VBAを使用して、セル[A1:G5]にあるデータを[A11]以下に順番に書き出したいですが、範囲が広い場合に上手く張り付かない現象が起きます。解決方法を教えてください。
• Excel-VBAを使って、セル[A1:G5]内のデータを[A11]の下に順番に書き出す方法について質問です。しかし、選択範囲が[A1:G1]や[A1:G5]のように広い場合、うまく書き出せません。何か解決策はありますか？
• Excel-VBAを使用してセル[A1:G5]のデータを[A11]以下に順番に書き出したいのですが、選択範囲が[A1:G1]や[A1:G5]のように広い場合にはうまく書き出せません。解決方法を教えてください。

回答No.5

end-u

>ヘルプ
>ANo.3 前回の試行では動作したのですが、今日は何故だか実行エラーが出ます!?
>その都度、[デバッグ(D)]⇒[ステップイン(F8)]をクリックすれば次に進みますが、
>何故実行エラーが発生するのでしょうか!?
確かに実行環境によってはエラーが出ますね。
「OpenClipboardに失敗しました」の文字通り、クリップボードがOpenできないようです。
DataObjectを使うコードはLoopを繰り返す処理には向いてないのでしょう。
そういう事も踏まえて test5,6 を提示してみました。

Win32API関数というものを使って、OpenClipboardできるまで待機する..
という手もありかと思いますが、
冗長になりますし、それほどDataObjectに拘るつもりもないですから、
ここは素直にSplitをメインにした配列処理を使われると良いと思います。

以下はあくまで参考です。
Win32APIではなく、Application.ClipboardFormatsを判定に使って待機する例。
#いずれにしても、エラー処理などで冗長になりますね。

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub test7()
　　Const MX As Long = 100 '待機Loop回数
　　Dim r As Range
　　Dim s As String
　　Dim i As Long
　　Dim j As Long
　　Dim n As Long
　　Dim x

　　On Error GoTo errHndlr
　　Application.ScreenUpdating = False
　　Application.StatusBar = ""
　　Set r = Range("A1:G5")
　　Range("A11", Cells(Rows.Count, 1).End(xlUp)).Clear
　　n = 11
　　With New DataObject
　　　　For i = 1 To r.Columns.Count
　　　　　　'Copy成功するまで待機
　　　　　　For j = 1 To MX
　　　　　　　　r.Columns(i).Copy
　　　　　　　　DoEvents
　　　　　　　　x = Application.ClipboardFormats
　　　　　　　　If UBound(x) > 2 Then Exit For
　　　　　　　　Sleep 100
　　　　　　Next
　　　　　　If j > MX Then
　　　　　　　　Err.Raise 1000
　　　　　　End If

　　　　　　.GetFromClipboard
　　　　　　s = .GetText(1)
　　　　　　.Clear
　　　　　　.SetText Replace$(s, """", "")
　　　　　　.PutInClipboard
　　　　　　ActiveSheet.Paste Cells(n, 1)
　　　　　　n = Cells(Rows.Count, 1).End(xlUp).Row + 1
　　　　Next
　　End With
　　On Error Resume Next
　　Range("A11", Cells(n, 1)).SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp
　　On Error GoTo 0
errHndlr:
　　Application.CutCopyMode = False
　　Application.StatusBar = False
　　Set r = Nothing
　　If Err.Number <> 0 Then
　　　　MsgBox Err.Number & "::" & Err.Description
　　End If
End Sub

お礼

end-uさん、
ご丁寧なご教授本当に有難うございました。
今回の課題解決には、
ご推奨の「test5,6」を活用させていただきます。
今後ともよろしくお願いいたします。
以上