| |
▼UO3 さん：
返信ありがとうございます。
>アップされたサンプルデータも、まだ見ていませんし、コードも、ざらっと眺めただけですが、
>ループ構文の書き方としては、大いに改善すべき点はあるとして、
申し訳ありません。問題点が多くあることはわかってはいますが、
自分なりにやった結果、これ以上の改善方法がわからなかったので、
そちらも助言を頂けると嬉しいです。
>まず、ほんとうに『型が違います』というエラーでしたか？
>1004 で、『不適切です』といったエラーではなかったですか？
>
>>Sheets(1).Range(Cells(i, "D"), Cells(i + Y - 1, "D")).Copy Sheets(2).Range(Cells(m, 4), Cells(m, 4 + Y))←「型が違います」と表示され処理ができない．
>これはSheets(1)のD列の『縦』の領域を、Sheets(2)のD○から右の『横』の領域にコピペしようとしていますね。
やりたい処理は、おっしゃる通りです。
確かに「型が一致しません」というエラーでした。
ただ、行列入れ替えを試してみましたので、新しいコードを記載させていただきます。
>それと、なぜ
>Application.DisplayAlerts = False
>が、あるのでしょう？
>ざっと見る限り、これが必要なコード実行は見あたりませんが？
申し訳ありません。上記のコードは不要でしたので、
消去しました。
また、コードを張らせていただきますので、
改善点がございましたら、お手数ですがご返信を頂けると幸いです。
--------------------------------------------------------------------------
Sub コピペ()
i = 2
j = 2
m = 2
n = 3
o = 4
p = 5
q = 6
r = 7
p01:
If Cells(i, "A") = "" Then
Sheets(1).Cells(i + 1, "A").Copy Sheets(2).Cells(j, "A")
Sheets(2).Range(Cells(j, "A"), Cells(j + 5, "A")).MergeCells = True 'アプリケーション定義またはオブジェクト定義のエラー（上手く行く時もある）
Sheets(1).Cells(i + 1, "B").Copy Sheets(2).Cells(j, "B")
Sheets(2).Range(Cells(j, "B"), Cells(j + 5, "B")).MergeCells = True
Sheets(1).Cells(i + 1, "J").Copy Sheets(2).Cells(j + 1, "V")
Sheets(1).Cells(i + 1, "K").Copy Sheets(2).Cells(j + 3, "V")
Sheets(1).Cells(i + 2, "K").Copy Sheets(2).Cells(j + 4, "V")
Sheets(1).Cells(i + 3, "K").Copy Sheets(2).Cells(j + 5, "V")
j = j + 6
Y = Cells(i + 1, "B").Value
Sheets(1).Range(Cells(i + 1, "D"), Cells(i + Y, "D")).Select
Selection.Copy
Sheets(2).Select
Range(Cells(m, 4), Cells(m, 4 + Y)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
m = m + 6
Sheets(1).Range(Cells(i + 1, "E"), Cells(i + Y, "E")).Select 'アプリケーション定義またはオブジェクト定義のエラーが発生
Selection.Copy
Sheets(2).Select
Range(Cells(n, 4), Cells(n, 4 + Y)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
n = n + 6
Sheets(1).Range(Cells(i + 1, "F"), Cells(i + Y, "F")).Select
Selection.Copy
Sheets(2).Select
Range(Cells(o, 4), Cells(o, 4 + Y)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
o = o + 6
Sheets(1).Range(Cells(i + 1, "G"), Cells(i + Y, "G")).Select
Selection.Copy
Sheets(2).Select
Range(Cells(p, 4), Cells(p, 4 + Y)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
p = p + 6
Sheets(1).Range(Cells(i + 1, "H"), Cells(i + Y, "H")).Select
Selection.Copy
Sheets(2).Select
Range(Cells(q, 4), Cells(q, 4 + Y)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
q = q + 6
Sheets(1).Range(Cells(i + 1, "I"), Cells(i + Y, "I")).Select
Selection.Copy
Sheets(2).Select
Range(Cells(r, 4), Cells(r, 4 + Y)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
r = r + 6
Else
End If
i = i + 1
GoTo p01
End Sub
|
|
タケル
- 12/8/15(水) 22:17 -
