Excel2003のマクロに関する質問です。


条件に合った複数行を全てコピーし、別のシートに貼り付けようと思っていろいろと探していたら、
question:1183079896を見つけました。
ここに載っているマクロを利用してみましたが、貼り付けられずに最終行まで行って終わるという状態になってしまいます。コピーはされているようなのですが、1行のみでした。

マクロをよく分かっていないために失敗したのだとは思います。
どうすれば「複数行まとめてコピーして、まとめて貼り付け」の流れが完成するのでしょうか。
また、自分でカスタマイズする際にはどこに気をつければよいでしょうか。

回答の条件
  • 1人5回まで
  • 登録:2007/07/31 09:50:00
  • 終了:2007/08/07 09:50:03

回答(2件)

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982007/07/31 11:15:50

ポイント35pt

せっかくなので 前回の不具合も修正して 回答します。

>ひとつのマクロで「Aはシート1、Bはシート2…」なんてできればすごいですが、どうなんでしょう。

Aだったら シート2

Bだったら シート3に複写するようにしました。

Call copysub("A", "Sheet2")

の部分の引数を 変更すればいいだけです。

Sub main()

Call copysub("A", "Sheet2")

Call copysub("B", "Sheet3")

End Sub

Sub copysub(a As String, s As String)

On Error GoTo ending

b = 0

Sheets("Sheet1").Select

Sheets("Sheet1").Range("A1").Select

start:

Sheets("Sheet1").Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate

If b > Selection.Row Then GoTo ending

b = Selection.Row

Rows(b & ":" & b).Copy

b = b + 1

Cells(b, 1).Select


Sheets(s).Select

Sheets(s).Range("A1").Select

p = 0

If Sheets(s).Range("A1") <> "" Then

If Sheets(s).Range("A2") = "" Then

Sheets(s).Range("A2").Select

Else

Selection.End(xlDown).Select

p = 1

End If

End If

If Selection.Row = 65536 Then

MsgBox "貼り付けができません。"

End

End If

Cells(Selection.Row + p, 1).Select

ActiveSheet.Paste

Sheets("Sheet1").Select

GoTo start

ending:

End Sub

id:ysoct22

回答ありがとうございます。

シート名と検索語をいじればいいだけだと思うのですが、どうもうまくいかないようです。

question:1183079896の方は大丈夫だったようですが…。

原因を突き止められずすみません。

2007/07/31 20:18:46
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912007/07/31 11:26:51

ポイント35pt

taknt さんが回答されているので、同じような内容だとは思いますが、複数後の検索に対応してみました。

★の部分を希望の環境に合わせてください。

1枚目のシートを検索し、結果を検索語の名前のシートにコピーします。

Option Explicit

Const searchRange = "A:D"  '--- ★検索元 検索範囲

Sub main()
    Dim searchWord As Variant
    For Each searchWord In Array("ABC", "DEF", "GHI") '--- ★検索する言葉をここで定義
        searchAndCopy CStr(searchWord)
    Next
End Sub

'------------------------------------------
' * 先頭シートから 引数で渡された検索語をコピーする
' * 結果は検索語と同じシート名にする
' * このため、シート名に使えない言葉は検索語とするとエラーになります。
'------------------------------------------
Sub searchAndCopy(sWord As String)
'------------------------------------------
    Dim srcWS As Worksheet
    Set srcWS = Worksheets(1)

    Dim dstWS As Worksheet
    On Error Resume Next
    Set dstWS = Worksheets(sWord)
    On Error GoTo 0
    If dstWS Is Nothing Then
        On Error Resume Next
        Set dstWS = Worksheets.Add(after:=Worksheets(Worksheets.Count))
        On Error GoTo 0
        If dstWS Is Nothing Then
            MsgBox "シート【" & sWord & "】が作成できません"
            Exit Sub
        End If
        dstWS.Name = sWord
    End If

    Dim resRng As Range
    Dim fstRng As Range
    Dim dstLine As Long

    '--- 書き込み先の先頭から書き出し:最初にクリア
    dstLine = 1
    dstWS.Rows(dstLine & ":" & dstWS.Range("A" & dstWS.Rows.Count).End(xlUp).Row).Clear

    '--- 検索先シートの serachRange で serachWord を検索
    With srcWS.Range(searchRange)
        Set resRng = .Find(what:=sWord, lookat:=xlPart)
        If resRng Is Nothing Then
            dstWS.Range("A1").Value = "コピーする行がありませんでした。"
            Exit Sub
        End If
        Set fstRng = resRng
        Do
            '--- 見つかったら書き込み先のシートにコピー
            resRng.EntireRow.Copy Destination:=dstWS.Rows(dstLine)
            dstLine = dstLine + 1
            Set resRng = .FindNext(resRng)
        Loop While resRng.Address <> fstRng.Address
    End With
End Sub
id:ysoct22

回答ありがとうございます。

こちらはきれいに動きました。挙動も想定していた通りで、僕の伝わりにくい表現を汲み取っていただいてありがとうございました。

もっとマクロ勉強しよう…。

2007/07/31 20:23:24
  • id:Mook
    参照元の私のコードは 「&」 が 「&amp;」になっているので修正してお試しください。

    必要などうの条件は、先頭の部分で定義していますので、動作対象に合わせて変更する必要があります。
  • id:taknt
    先の質問のは、一行単位でのコピーですからねぇ。

    検索してひっかかった行を 別のシートにコピーするだけです。

    つまり、複数行なら それ すべて 検索条件にあわないとダメです。

    もうちょっと 仕様を書いてもらえれば 作れますが。

    >「複数行まとめてコピーして、まとめて貼り付け」

    この複数行の指定の仕方ですね。

  • id:taknt
    あと 私のは Sheet2に 二行以上 A列に入っていないと ダメですね。
  • id:ysoct22
    >Mookさん
    ありがとうございます。
    今見てみたら元質問のコメント欄にありましたね…。すみません。
    記述を見ていろいろいじってみたらうまくいったような気がします。

    >takntさん
    こればっかりは読解力のなかった僕の問題です。
    一行単位だとは全く気づけず、ご迷惑をおかけしました。
    てっきり、検索とコピー&ペーストを一度に行うものだと想定してしまっていました。
    というか、「検索-コピー-貼り付け-検索…を全てに対して行う」ということがしたかったもので。
    読解力もなければ記述力もない…。

    ひとつのマクロで「Aはシート1、Bはシート2…」なんてできればすごいですが、どうなんでしょう。
  • id:taknt
    >ひとつのマクロで「Aはシート1、Bはシート2…」なんてできればすごいですが、どうなんでしょう。

    条件とコピー先シート名を 変更して 二つつくり
    それを 順に 並べれば いいだけです。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません