[[20130128104307]]　『条件に一致する行を別シートへコピー』（ゆき）　ページの最後に飛ぶ

『条件に一致する行を別シートへコピー』（ゆき）

 いつもお世話になっております。

 Excel2010で、VBAを作っています。

 「出荷データ」というシートの中から

 ・B列が「空白でない」＆　L列が「空白」

 というデータを抽出し、別シートにコピーしようとしています。

 別シートというのは、「出荷済未売上(雛形)」というシートをコピーして、「出荷データ」のC1セルにある
 「1月」といった値をシートに付け加えて「1月出荷済未売上」というシート名にし、その
 シートに上から順に「出荷データ」から抽出された行をそのまま（書式ごと）コピーしたいです。

 「出荷データ」「出荷済未売上」シート両方、2行目までが見出しで3行目からがデータ行です。

 それで下記のコードを書きました。

 Option Explicit

 Sub 未計上抽出()

 Dim i As Long
 Dim x As Long
 Dim z As Long
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet
 Dim FCell As Range

    Set ws1 = ThisWorkbook.Worksheets("出荷データ")

    z = ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row

    Set FCell = ws1.Range("L3:L" & z).Find(what:="")

    If FCell Is Nothing Then
        MsgBox "未計上データはありません"
        Exit Sub
    End If

    ThisWorkbook.Sheets("出荷済未売上(雛形)").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = ws1.Range("C1").Text & "出荷済未売上"
    Set ws2 = ThisWorkbook.Sheets(Sheets.Count)

    For i = 3 To z
        x = ws2.Range("B" & ws2.Rows.Count).End(xlUp).Row + 1

        If ws1.Cells(i, 2).Value <> "" And ws1.Cells(i, 12).Value = "" Then
            ws1.Range("A" & i).Copy ws2.Range("A" & x)
        End If
    Next i

 End Sub

 これを実行すると、A3セルに抽出されたデータの最終行の値が入るだけで（同じ行のB列以降は空白）
 データが抜き出せません。

 さらにコードをステップ実行すると、

    ActiveSheet.Name = ws1.Range("C1").Text & "出荷済未売上"

 のところで「同じシート名は利用できません」というエラーが出てコードが中断します。
 （ステップ実行しなければエラーになりません）

 抽出したデータを新しいシートにコピーする方法と、「同じシート名が～」のエラーが出るのを
 回避するにはどうしたらよいでしょうか？

 よろしくお願いします。

 後者のエラーがでる出ないは C1 のセル内容に依存すると思うのですが、
 マクロの実行のたびに C1 は変わるのでしょうか。
 同じ値「1月」で複数実行すると、エラーになりますので、そこはメッセージを
 出して中断するのか、再作成するのか仕様を決める必要があるかと思います。

 行全体をコピーするのであれば、
            ws1.Range("A" & i).Copy ws2.Range("A" & x)
 ではなく
            ws1.Range("A" & i).EntireRow.Copy ws2.Range("A" & x).EntireRow
 としてみてどうでしょうか。
 (Mook)

 (Mook)様ありがとうございます。

 コピーうまくいきました！

 ＞マクロの実行のたびに C1 は変わるのでしょうか
 いえ、変わらないので、何度も実行するとエラーになるのはわかるのですが、ステップ実行の時のみエラーが出るのが不思議で…

 できれば複数回実行してもエラーが出ないような方法があればいいのですが（例えばシート名の末尾に _2 のように枝番を付けるとか）
 前に類似の質問を見かけた気がするのでそれを検索しているところです…

 （ゆき）

 すみません、シート名に枝番を付ける件、自己解決しました

 （ゆき）

 うーん、
 シートが存在しているときに、ステップ実行でないときにエラーが出ないほうが
 不思議なのですが。

 枝番対応、ご自身で解決できたようで何よりです。
 上に書いたのは見てみると冗長で、
            ws1.Range("A" & i).EntireRow.Copy ws2.Range("A" & x).EntireRow
 は
            ws1.Rows(i).Copy ws2.Rows(x)
 で十分でしたね。
 (Mook)

コメント返信：

[ 一覧(最新更新順) ]

[[20130128104307]] 『条件に一致する行を別シートへコピー』（ゆき） ページの最後に飛ぶ

[[20130128104307]]　『条件に一致する行を別シートへコピー』（ゆき）　ページの最後に飛ぶ