エクセルvbaプログラムについての質問です。

question:1241597180 でも回答させていただいたとおり

SpecialCells(xlCellTypeBlanks) では指定された範囲内にブランクセルが無ければエラーになります。

また、一度も使われていない範囲のセルもエラー対象となります。

対応としては

Sub Macro1()
  On Error GoTo error_check: 'エラートラップ設定
  
  ' 貴殿の作ったループするプログラムはここに入る。

  Exit Sub: '正常終了時はここでルーチン終了

error_check: 'エラートラップ(該当するセルが見つかりません。ならば無視して続けさせる)
  If Err.Number = 1004 Then On Error Resume Next
End Sub

といった具合にエラー1004（該当するセルが見つかりません。）が発生しても

強制的に先に進ませるような工夫が必要になります。

ただし、エラー制御は「想定外のエラー（想定外ですから、何が起こるか判りません）」まで

スルーして動作を続けてしまう可能性があるためあまりお勧めは出来ません。

では、どうすれば良いのか・・・。

Range("aa1:ca1").SpecialCells(xlCellTypeBlanks)(1, 1).Select

といった具合に一列多めにしてやります。

当然ながら列CAは全て空白である必要がありますし、

一度でも何らかの値が入っていないと、これまたエラーとなりますので

一度だけ CA500（CA列全部でなくて良いです。一番右下だけでＯＫです） に値を書き込んで

直ぐに消すという事をやっておきましょう。

もしも、CA列(79列目)にまで何かが貼り付けられてしまうという可能性があるのならば

If Range("aa1:ca1").SpecialCells(xlCellTypeBlanks)(1, 1).Column < 79 Then

などといった回避策もこうじておく必要があるでしょう。

具体的なコードも書けなくはないのですが

＞列は　m1:q1～m5:q5

に対して

＞n1からq1まで同様

だけしか書いておられないので、m2:q2～m5:q5 はどう扱ってよいものやら判らず

とりあえずヒントだけとさせていただきます。

質問文の字数制限により削られたのでしょうけど、失敗されたVBAコードを

コメント欄にでも書いてみてはどうでしょうか？

（誰かがそのものズバリのコードを書いてくれるかもしれません。）

http://q.hatena.ne.jp/answer

for文で回せば大丈夫です。

サンプルを掲載しておきます。

Option Explicit

Sub PasteCells()
    
    Dim oRng As Range
    Dim oSrcRngs As Range
    Dim i As Integer
    
    For i = 1 To 500
        Sheets("××").Select
        Set oSrcRngs = Range(Cells(i, "m"), Cells(i, "q"))
        Sheets("○○").Select
        For Each oRng In oSrcRngs
            oRng.Copy
            ActiveSheet.Paste (Range(Cells(i, "aa"), Cells(i, "bz")) _
                .SpecialCells(xlCellTypeBlanks)(1, 1))
        Next
    Next
End Sub

★注意

＞行は　aa1:bz1～aa500:bz500

＞列は　m1:q1～m5:q5

　多分m1:q1～m500:q500をaa1:bz1～aa500:bz500の空白箇所にペーストしていきたいという意図と思い、作成しました。

ブランクセルが十分にないなどのエラーチェックはしていません。m1～q1の５個が必ずaa1:bz1に入る仮定です。

なお、既にご存知と思いますが、xlCellTypeBlanksは曲者で、利用範囲が矩形で自動検出され、その中のブランクセルのみが選択されます。

エラーを起こした場合は、「編集」→「ジャンプ」→「セル選択」→「空白セル（ラジオボタン）」にて、ブランクセルがあるかどうか確認ください。

http://www.google.co.jp <dummy>