ここから本文です

マクロ、VBA 途中の空白に別シートのセルを貼り付けについて シート1のA列に...

ran********さん

2018/2/2719:18:49

マクロ、VBA
途中の空白に別シートのセルを貼り付けについて

シート1のA列に文字が入力されており、途中にいくつか空白があります。

その空白にシート2のA列を入力したいです。
ちな

みにシート2のA列は全て文字が入っています。
入力するのは列の順番通りで大丈夫です。(シート1のA4が空白→シート2のA4を貼り付け)

初心者の為ご教授をお願いします。

閲覧数:
32
回答数:
2
お礼:
25枚

違反報告

ベストアンサーに選ばれた回答

kky********さん

2018/2/2809:11:50

Sheet1の最終行までの処理にしてあります。

Sub Sample()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long
Application.ScreenUpdating = False
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
With sh1
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Range("A" & i).Value = "" Then
.Range("A" & i).Value = sh2.Range("A" & i).Value
End If
Next i
End With
Application.ScreenUpdating = True
End Sub

質問した人からのコメント

2018/2/28 21:38:47

お二方ともありがとうございます!
こちらの方が理解しやすかったためベストアンサーに選ばせて頂きます。

ベストアンサー以外の回答

1〜1件/1件中

プロフィール画像

カテゴリマスター

tra********さん

2018/2/2809:58:59

シート1の行数が、シート2の行数より小さい時の対応を考えないとダメですね。

Sub Sample()
Dim sh2 As Worksheet, rng As Range, rngs As Range
Dim xAdr
Application.ScreenUpdating = False
Set sh2 = Worksheets("Sheet2")
xAdr = sh2.Range("A1", sh2.Cells(Rows.Count, 1).End(xlUp)).Address
With Worksheets("Sheet1").Range(xAdr)
If Application.CountBlank(.Cells) > 0 Then
For Each rng In .SpecialCells(xlCellTypeBlanks).Areas
sh2.Range(rng.Address).Copy rng
Next rng
End If
End With
Application.ScreenUpdating = True
End Sub

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる