マクロでテーターを転記した時の空白なしに

質問

いつもお世話になります。
WINDOWS7 EXCEL2010　です。

添付図で説明させていただきますと、
右側の「請求書」のL5:O9　のデーターを左の「売上表」に下記のマクロにて転記します。

元の値(請求書　L5:O9)の範囲内のデーターが1行　2行　3行　4行は空白行が又は5行の場合はすべてが埋まったりします。
この場合5行の時はいいのですが、例えばデーターが3行の時は添付図で言いますと5の行6の行のように2行が空白になります。

下記のマクロの構文をどういう具合にすればいいか御指導願えませんでしょうか。

参考に、
L5 =IF(B15="","",B15)
M5 =IF(L5="","",$A$2)
N5 =IF(L5="","",C15)
O5 =IF(L5="","",H15)
※ 下記のようにしたかったのですがマクロに詳しくないのと時間がないので上記のような方法になり少し遠回りです。
‘Range("B1").Select
‘ActiveCell.Offset(1, 0).Activate

マクロです。
Sub 売上表へ転記()
Dim ID As Long
Dim 納品日 As Date

ID = Range("M5").Value
日付 = Range("L5").Value

Range("L5:O9").Copy

Sheets("売上表").Activate
Range("A65536").End(xlUp).Activate
'販売記録A2がアクティブセル(タイトル行)
ActiveCell.Offset(1, 0).Activate

ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'A2:E2
ActiveCell.Offset(0, 4).Activate
'C2が空白
Do Until ActiveCell.Offset(2, 0).Value = ""

ActiveCell.Value = ID
'G2
ActiveCell.Offset(0, 0).Value = 納品日
'A3
ActiveCell.Offset(1, 0).Activate

Loop

End Sub

回答No.3

tom04 · ベストアンサー

続けてお邪魔します。

＞Module7 に入れていてこれ以外はありません。
＞同じ内容のエラーが出ます。
というコトは「インデックスが有効範囲にありません」というエラーになるのでしょうか？
ん～～～
やはりシート名に関するエラーのような感じがしますが・・・
とりあえず前回のコードを少し変更してみました。
（★印の行だけです）

Sub 転記2()
Dim i As Long, wS As Worksheet
Set wS = Worksheets("売上表")
Worksheets("納請書1").Range("L5:O9").Copy
wS.Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues '★
Application.CutCopyMode = False
For i = wS.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1 '★
If WorksheetFunction.CountIf(wS.Cells(i, "A").Resize(, 4), "") = 4 Then
wS.Cells(i, "A").Resize(, 4).Delete shift:=xlUp
End If
Next i
End Sub

※　Usedrangeを使わずにA列で最終行を取得するようにしています。
※　シートモジュールではなく、
必ずAlt＋F11キー　→　メニュー　→　挿入　→　「標準モジュール」にコードを記載してください。

これでもエラーになる場合、原因は判りかねます。m(_ _)m

お礼

ありがとうございました。

御迷惑とご手数おかけしました。

補足

おはようございます。
今朝気合を入れて色々試しながらやり直しました。

マクロはNo1の構文でうまくできました。

売上表　納請書　のそれぞれのシートを新たに再作成したところうまくできました。

御迷惑とご手数おかけしました。

回答No.2

tom04

No.1です。

＞※Worksheets("請求書").Range("L5:O9").Copy
＞シート名は「納請書1」なので下記のように変更しました。
＞Worksheets("納請書1").Range("L5:O9").Copy

こちらでもシート名を「納請書1」に訂正してマクロを実行してみました。

ちゃんと「納請書1」のL5～O9セルが「売上表」シートのA列以降に表示できました。

※　当方の解釈としては、単に「納請書1」シートのL5:O9セルを「表示表」シートのA列に
「値」として貼り付け、”空白に見える行”を削除しているだけですが、
そのほか細かい設定があるのでしょうか？
標準モジュールにコードを記載していますか？
そうであれば
エラー原因としてはおそらくシート名だけの問題のような気がします。

この程度でごめんなさい。m(_ _)m

補足

何度もすみません。

Module7 に入れていてこれ以外はありません。
同じ内容のエラーが出ます。

Sub 転記()
Dim i As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("売上表")
lastRow = wS.UsedRange.Rows.Count
Worksheets("納請書1").Range("L5:O9").Copy
wS.Cells(lastRow, "A").Offset(1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
For i = wS.UsedRange.Rows.Count To 2 Step -1
If WorksheetFunction.CountIf(wS.Cells(i, "A").Resize(, 4), "") = 4 Then
wS.Cells(i, "A").Resize(, 4).Delete shift:=xlUp
End If
Next i
End Sub

回答No.1

tom04

こんばんは！

「請求書」シートのL5～O9セルデータを「売上表」シートに上詰めで標示すれば良い訳ですよね？

Sub Sample1()
Dim i As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("売上表")
lastRow = wS.UsedRange.Rows.Count
Worksheets("請求書").Range("L5:O9").Copy
wS.Cells(lastRow, "A").Offset(1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
For i = wS.UsedRange.Rows.Count To 2 Step -1
If WorksheetFunction.CountIf(wS.Cells(i, "A").Resize(, 4), "") = 4 Then
wS.Cells(i, "A").Resize(, 4).Delete shift:=xlUp
End If
Next i
End Sub

※　セルの表示形式はあらかじめ設定しておいてください。

こんな感じではどうでしょうか？m(_ _)m

補足

早速のご指導ありがとうございます。
御指導を試させていただいたら下記のごとくエラーがでました。
再度ご指導願えませんでしょうか。

実行時エラー'9':
インデックスが有効範囲にありません。
下記の構文に黄色で反転しています。
　　　　※Worksheets("請求書").Range("L5:O9").Copy
　　　　　シート名は「納請書1」なので下記のように変更しました。
Worksheets("納請書1").Range("L5:O9").Copy