dポイントプレゼントキャンペーン実施中!

こんばんわ!
VBAを実行すると、画面がちかちかします。
シートを行ったり来たりしているせいでしょうね?

自分で、色々やってみたのですが、エラーばかりで全然できません。

シートを行ったり来たりしなくてもいいVBAを作るには、どこを直せばいいでしょうか。
教えて頂けませんか?

(現在のVBA)
(1)「Data!FB63376,FG63376,FI63376」を「拾い出し!K4」にコピー&ペースト
値が入っている場合、下の行に貼付け。

Sub Macro1()

Range("FB63376,FG63376,FI63376").Select  
Range("FI63376").Activate
Selection.Copy
Sheets("拾い出し").Select

If Range("K4").Value = "" Then
Range("K4").Select
Else

Range("K" & Rows.Count).End(xlUp).Offset(1).Select 
End If

ActiveSheet.Paste
Sheets("Data").Select



(2)「Data!FO63367:FQ63372」を「拾い出し!O4」に値のみをコピー&ペースト
値が入っている場合、下の行に貼付け。

Range("FO63367:FQ63372").Select
Selection.Copy
Sheets("拾い出し").Select

If Range("P4").Value = "" Then

Range("P4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else

Range("P" & Rows.Count).End(xlUp).Offset(1).Select
End If

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Data").Select

Application.CutCopyMode = False
End Sub

以上です。
お分かりになる方教えて頂けませんか?
宜しくお願いします。

A 回答 (3件)

いちいちSelectしなくてもいい。



Sub Macro1()

Range("FB63376,FG63376,FI63376").Copy

With Sheets("拾い出し")

If .Range("K4").Value = "" Then
.Range("K4").PasteSpecial
Else

.Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
End If
End With

というように。

この回答への補足

okormazdさんが、回答ありがとうございました。
すごい短くなるんですね~
教えて頂いたのを早速実行させて頂きました。

(結果)
「Data!FB63376,FG63376,FJ63376」⇒「Data!K4,L4,M4」へコピー
「Data!FP63367:FR63372」⇒「拾い出し!O4」へコピー

(希望)
「Data!FB63376,FG63376,FJ63376」⇒「拾い出し!K4,L4,M4」へコピーしたいです。

二つ共 With Sheets("拾い出し")に しているのに、片方は「Data!K4,L4,M4」に、片方は「拾い出し!K4,L4,M4」になります。どこがいけないのでしょうか?

Sub Macro1()

Range("FB63376,FG63376,FJ63376").Copy
With Sheets("拾い出し")

If Range("K4").Value = "" Then
Range("K4").PasteSpecial Paste:=xlPasteValues
Else

Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With

Range("FO63367:FQ63372").Copy

With Sheets("拾い出し")


If Range("P4").Value = "" Then

.Range("P4").PasteSpecial Paste:=xlPasteValues
Else

.Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If

End With

End Sub
申し訳ありませんが教えて頂けませんか?

補足日時:2009/11/27 01:05
    • good
    • 0
この回答へのお礼

okormazdさん、回答ありがとうございました。

補足に書かせて頂きましたが、一つだけうまくいきません。

教えて頂けませんか。

よろしくお願いします。

お礼日時:2009/11/27 01:57

こんにちは。



RangeがどのシートのRangeなのか明確に書くクセをつけましょう。

例えば、K4セルは、"拾い出し"シートにも"Data"シートにも存在しますよね。

Range("K4") と書かれたセル範囲は、親オブジェクトが示されていないのでアクティブシートが対象になります。つまり、"拾い出し"シートにも"Data"シートのセルにもなるんです。
一方、
Sheets("拾い出し").Range("K4") と書くと、親オブジェクトが指定されているので"拾い出し"シートのK4セルであることがきちんとエクセル君に伝わるのです。

質問者さんが提示されたコードでも . がRangeの前に書かれていないので、Withで指定されたオブジェクトが、親オブジェクトとして指定されておらず、アクティブシートが対象になって処理されているから意図した処理になっていないんです。

まず、Withステートメントを使う前にそれぞれのRangeの前にシート名を付け、その上でWithステートメントでオブジェクトをまとめるようにしてみてください。

Sub Macro1編集前()

If Sheets("拾い出し").Range("K4").Value = "" Then
  Sheets("Data").Range("FB63376,FG63376,FI63376").Copy _
    Destination:=Sheets("拾い出し").Range("K4")
Else
  Sheets("Data").Range("FB63376,FG63376,FI63376").Copy _
    Destination:=Sheets("拾い出し").Range("K" & Rows.Count).End(xlUp).Offset(1)
End If


Sheets("Data").Range("FO63367:FQ63372").Copy

If Sheets("拾い出し").Range("P4").Value = "" Then

  Sheets("拾い出し").Range("P4").PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else

  Sheets("拾い出し").Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _
    Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

End If

Application.CutCopyMode = False

End Sub


Sub Macro1編集後()

With Sheets("拾い出し")

  If .Range("K4").Value = "" Then
    Sheets("Data").Range("FB63376,FG63376,FI63376").Copy _
      Destination:=.Range("K4")
  Else
    Sheets("Data").Range("FB63376,FG63376,FI63376").Copy _
      Destination:=.Range("K" & Rows.Count).End(xlUp).Offset(1)
  End If


  Sheets("Data").Range("FO63367:FQ63372").Copy

  If .Range("P4").Value = "" Then

    .Range("P4").PasteSpecial Paste:=xlPasteValues, _
      Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Else

    .Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _
      Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

  End If

End With

Application.CutCopyMode = False

End Sub
    • good
    • 0
この回答へのお礼

OtenkiAmeさん、こんばんわ!
回答ありがとうございます。

>RangeがどのシートのRangeなのか明確に書くクセをつけましょう。
そうですね、Rangeをきちんと書かないと駄目ですね。
説明して頂いたのを、見て理解出来ました。
後、編集前・編集後と書けばわかりやすくていいですね。

みなさんのお陰で、うまく出来ました。
ありがとうございました。
今後共、よろしくお願いします。

お礼日時:2009/11/27 03:10

長々とコードを載せているが関係ないのでは>


http://www.serpress.co.jp/excel/vba035.html
のように
Application.ScreenUpdating = False(最後にTrueに戻す)
を入れて仕舞いではないのですか。これはエクセルVBAの常識といったことですよ。
Googleででも「vba 画面の更新を止める」で照会すれば沢山記事がある。
    • good
    • 0
この回答へのお礼

imogasiさん、回答ありがとうございました。

imogasiさんの、やり方で直りました。

ありがとうございました。
今後共、よろしくお願いします。

お礼日時:2009/11/27 01:05

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!