出産前後の痔にはご注意!

いろいろ検索をしたりしたのですがわからず
質問というかお願いをさせていただきます。

sheet1のi行のL:R列が全て入力されていた場合切取をし
sheet2の最終行へ貼付をする

ということをさせたいのですが
どのようにマクロを組めばいいのかいまいちわからず
試したのですが何が違うのかわからず前へ進めません。

宜しくお願い致します。

杉崎

このQ&Aに関連する最新のQ&A

A 回答 (3件)

ANo.2です。


sheet2の1行目から貼り付けるのかとか、sheet1には値のみ(計算式はない)とか、A列に必ず値が入っているかとかによっても違うと思いますが・・・
とりあえず、L:Rはすべて入力されているデータだけがSheet2にあるはずなので、Sheet2の最後の行をL列でチェックします。

sheet2の1行目にはデータ貼り付けなくてもいい場合
If WorksheetFunction.CountBlank(Sheet1.Range("L" & i & ":R" & i)) = 0 Then 'i行のL:Rにブランクがなければ
Sheet1.Range("A" & i & ":R" & i).Copy Destination:=Sheet2.Range("L" & Sheet2.Rows.Count).End(xlUp).Offset(1, -11) 'L列の最後の行の次の行のA列からにコピー
Sheet1.Range("A" & i & ":R" & i).ClearContents '元データをクリア
End If

sheet2の1行目にもデータ貼り付ける場合(ついでに値のみをコピー)
If WorksheetFunction.CountBlank(Sheet1.Range("L" & i & ":R" & i)) = 0 Then 'i行のL:Rにブランクがなければ
Sheet1.Range("A" & i & ":R" & i).Copy 'i行のA:Rをコピー
If Sheet2.Range("L1") = "" Then '前にデータがコピーされていればL1にはデータが入っているはず
Sheet2.Range("A1").PasteSpecial Paste:=xlValues '1行目に値のみを貼り付け
Else
Sheet2.Range("L" & Sheet2.Rows.Count).End(xlUp).Offset(1, -11).PasteSpecial Paste:=xlValues 'L列の最後の行の次の行のA列からに値のみを貼り付け
End If
Sheet1.Range("A" & i & ":R" & i).ClearContents '元データをクリア
End If

とかではどうでしょうか?
    • good
    • 0

Dim sr As Range


Dim dr As Range
Set sr = Sheet1.Range(Sheet1.Cells(i, 12), Sheet1.Cells(i, 18))
If WorksheetFunction.CountBlank(sr) = 0 Then
Set dr = Sheet2.Cells(Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row + 1, 1)
sr.Copy Destination:=dr'コピー
sr.ClearContents '元データをクリア
End If

srは、
Set sr = Sheet1.Cells(i, 12).Resize(1, 7)
Set sr = Sheet1.Range("L" & i & ":R" & i)
にもできます。

値のみをコピーする場合は(元データに計算式がある場合など)
sr.Copy Destination:=dr

sr.Copy
dr.PasteSpecial Paste:=xlValues
にします。

ただし、上記はSheet2の1行目にはコピーしないので、1行目からコピーする場合は、
Dim sr As Range
Dim dr As Range
Set sr = Sheet1.Range(Sheet1.Cells(i, 12), Sheet1.Cells(i, 18))
If WorksheetFunction.CountBlank(sr) = 0 Then
If Sheet2.Cells(1, 1) = "" Then
sr.Copy Destination:=Sheet2.Cells(1, 1)
Else
Set dr = Sheet2.Cells(Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row + 1, 1)
sr.Copy Destination:=dr 'コピー
End If
sr.ClearContents '元データをクリア
End If
にします。

この回答への補足

言葉足らずで申し訳ありません。
L:R列が全て入力されていた場合
A:Rを切取sheet2の最終行へ貼付とする場合は
どのようにするといいでしょうか。

補足日時:2008/02/25 18:19
    • good
    • 0

これ何も新しいVBAの知見は要らない問題と思う。


2シートを扱いなれてないのができない理由でしょう。
それとロジックの組み立て方が経験不足。
そういう面のなれ(自分流のやり方の確立)が必要。だから下記も
唯一のコード記法ではないでしょうが。
例データ Sheet1
A,B列 C列以右列は省略
aa
bb
cc
dd
ee
ff
gg
hh
ii
ーーー
Sheet1の
L列ーR列(画面がわかりやすいように分けて書いただけ)
ーは空白セルの意味。
1111111
1ー11111
1111111
111ー111
1111111
1111111
11ー1111
1111111
1111111
ーーー
コード
標準モジュールに
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d1 = sh1.Range("A65536").End(xlUp).Row
MsgBox d1
For i = 1 To d1
For j = 12 To 18
If sh1.Cells(i, j) = "" Then
GoTo p1
Else
End If
Next j
'--
MsgBox i
d2 = sh2.Range("A65536").End(xlUp).Row
sh1.Range(sh1.Cells(i, "A"), sh1.Cells(i, "R")).Copy _
Destination:=sh2.Range("A" & d2 + 1)
'---
p1:
Next i
End Sub
結果
Sheet2に
A2:B7
aa
cc
ee
ff
hh
ii
L2:R7は全セルが1
Sheet1でA列で値で言えば
b、d、gの行が、L-R列に空白があるので、捨てられた。
sheet2は実行の都度、行的に累積される。
    • good
    • 0

このQ&Aに関連する人気のQ&A

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


このカテゴリの人気Q&Aランキング