こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBA Do Until内で値の貼り付けができない

Excel2003を使用しております。

コピー&値のペースト作業をやってくれるマクロを作成しております。
具体的には、名簿に公がついていれば、その3つ左の名前をD27へ値のみコピペし、
D27がすでに値があれば、D28に書くことを、D37までループするようにしております。
しかし困ったことに、Do Untilコードを使用しておりますが、このコードではなぜか値の貼り付けが出来なくなります。


Sub Ns公()
Dim work As Range
Set work = Selection
If Selection.Value = "公" Then
ActiveCell.Offset(0, -3).Select
Selection.Copy
Do Until Range("D37").Select
Range("D27").Select
If Selection.Value = "" Then
Selection.PasteSpecial paste:=xlPasteValues
work.Select
Else
ActiveCell.Offset(1).Select
End If
Loop
If Range("D36").Value <> "" Then
Do Until Range("I37").Select
Range("I27").Select
If Selection.Value = "" Then
Selection.PasteSpecial paste:=xlPasteValues
work.Select
Else
ActiveCell.Offset(1).Select
End If
Loop
work.Select
End If
work.Select
End If
work.Select
ActiveCell.Offset(1).Select
End Sub

原因や対策をご教授いただけるとうれしいです。よろしくお願いします。

投稿日時 - 2012-05-21 18:16:04

QNo.7488307

困ってます

質問者が選んだベストアンサー

本当は、「ここをこう直す」と言う感じでアドバイスできればよかったんですが、Selectを多用されているので追いづらくって断念しました。
代わりに、提示された説明とコードから、こういうことがしたいのかなと推測して作ってみました。

Sub Sample()
  Dim nRow As Long
  If Selection.Value = "公" Then
    '値貼り付け位置を確認
    nRow = Range("D38").End(xlUp).Row
    If nRow = 37 Then
      MsgBox ("D37まで書き込み済み")
      Exit Sub
    ElseIf nRow < 27 Then
      nRow = 26
    End If
    '値をD27以下の空セルに代入
    Range("D" & nRow + 1) = ActiveCell.Offset(0, -3).Value
  End If
  '選択セルを一行下げる(元から入っているので残しました)
  ActiveCell.Offset(1).Select
End Sub

VBAで値のコピーをする場合、いちいちSelectする必要はありません。
まずはSelection.CopyとSelection.Pasteを使わないコードを目指しましょう。

投稿日時 - 2012-05-21 18:54:35

お礼

ご丁寧にありがとうございます。
このままコピーで使用できます(感動)

お忙しいところ
ありがとうございました!!

投稿日時 - 2012-05-21 20:52:07

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

-広告-
-広告-

回答(1)

-広告-
-広告-

あなたにオススメの質問

-広告-
-広告-