エクセルvbaについて

Question

画像のファイルのA列に〇があるもののみ別のファイルに転記して頂きたいです。
転記するファイルはC列、E列、K列、O列、S列、U列にそれぞれ分かれていて、スタートは必ず13行目からです。
多い時で200程あります。
これを別ファイルのA1から下に順番になるようにし、尚且つ分かれている数字やアルファベットを1つのセルに繋げたあと、最後に右端にすべて＊を付ける。(画像参照して下さい。)
マクロの処理ですが、転記するファイルを開いている状態で実行して別ファイルに転記するといった感じです。別ファイルは開いていても、開いていなくても転記できるようにしたいです。
別ファイルの場所とファイル名は下記になります。
C:\Users	-tai\OneDrive\デスクトップ\図番\図番転記.xlsx
よろしくお願いします。

tatsumaru77 · Accepted Answer

>② maxrow1 = 500で実行するとできました。
>これでも大丈夫ですけど。

本来であれば、
maxrow1 = ws1.Cells(Rows.Count, "C").End(xlUp).Row
の行で、エラーが発生する原因を特定し、それを解決するのが正しい対処法です。しかしながら、そのエラーとなるブックのシートが手元にないので、思い当たる原因がこれ以上思いつきません。

とりあえず、最後まで実行できたようなので、他に問題がなければ、これでクローズしたいと思いますが、いかがでしょうか。
今後、最大行が500を超える可能性があるようでしたら、もう少し多めの値をmaxrow1に設定しておいてください。

tatsumaru77 · Answer

>こちらも試してみましたが変わりません。
>100４表示が出ます。
>列の指定がううまくできていないのでしょうか？
>一端、ベストアンサーに選んで、再度質問をしてもう一度画像を送りましょ>か？

エラーは、どの行で起こってますか。
①    'maxrow1 = ws1.Cells(Rows.Count, "C").End(xlUp).Row
②   maxrow1 = 500

①はコメントアウトされているので、エラーは発生しません。
②でエラーが起こるのは感がられません。

tatsumaru77 · Answer

>頂いたコードを試してみましたが、やはり同じです。
>エラーコード1004が出ます。
>何度もやってみましたがダメでした。

あてずっぽうですが、何かそのシートに原因があるように思われます。

とりあえず、その現象を避けるために、その行をコメントアウトして、
最大行を直接設定して、再度実行していただけませんでしょうか。
例えば、最大行が５００なら、

maxrow1 = ws1.Cells(Rows.Count, "C").End(xlUp).Row
の行を

'maxrow1 = ws1.Cells(Rows.Count, "C").End(xlUp).Row
    maxrow1 = 500
のようにします。
この500は実際の最大行より多めにとっても問題ありません。

tatsumaru77 · Answer

前回のマクロは破棄してください。
こちらを、標準モジュールに登録してください。

Option Explicit

Public Sub 別ファイルへ転記()
    Dim fpath As String
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim wb2 As Workbook
    Dim ws2 As Worksheet
    Dim maxrow1 As Long
    Dim row1 As Long
    Dim row2 As Long
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    fpath = "C:\Users	-tai\OneDrive\デスクトップ\図番\図番転記.xlsx"
    Set wb2 = Nothing
    For Each wb In Workbooks
        If wb.Name = "図番転記.xlsx" Then
            Set wb2 = wb
            Exit For
        End If
    Next
    If wb2 Is Nothing Then
        Set wb2 = Workbooks.Open(fpath)
    End If
    Set ws2 = wb2.Worksheets(1)
    ws2.Cells.ClearContents
    row2 = 1
    maxrow1 = ws1.Cells(Rows.Count, "C").End(xlUp).Row
    For row1 = 13 To maxrow1
        If ws1.Cells(row1, "A").Value = "○" Then
            ws2.Cells(row2, "A").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _
            ws1.Cells(row1, "O").Value & ws1.Cells(row1, "S").Value & ws1.Cells(row1, "U").Value & "*"
            row2 = row2 + 1
        End If
    Next
End Sub

tatsumaru77 · Answer

>マクロ登録は転記元のブックで間違いありません。　
>シートも最前面、1番左のシートです。

こちらでは、動作しているのですが、あなたの環境ではアクティブシートが正しく動作していないように見えます。

転記元のシートのシート名を提示していただけませんでしょうか。
シート名を直接指定して、そのシートを操作するように変えたいと思います。

tatsumaru77 · Answer

もし、No4の
転記元のブックにマクロが格納されているが、それでもエラー１００４
が発生するということでしたら、転記元のシートを直接指定したいと思います。
転記元のシートのシート名は何でしょうか。

tatsumaru77 · Answer

No3です。
念のため確認ですが、マクロが登録されているブックは、
転記元のブックで間違いないでしょうか。
転記元のブックにマクロが格納されている前提です。
転記元のブックの現在最前面に表示されているシートが転記対象となります。

tatsumaru77 · Answer

>実行してみましたが、
>maxrow1 = ws1.Cells(Rows.Count, "C").End(xlUp).Rowのところで
>エラーコード1004が表示されます。

転記元のシートを最前面に表示した状態で、マクロを実行してますでしょうか。
転記元のシートが最前面に表示された状態で、マクロを実行することが前提となっています。

tatsumaru77 · Answer

No1です。
以下のマクロを標準モジュールに登録してください。

Option Explicit

Public Sub 別ファイルへ転記()
    Dim fpath As String
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim wb2 As Workbook
    Dim ws2 As Worksheet
    Dim maxrow1 As Long
    Dim row1 As Long
    Dim row2 As Long
    Set ws1 = ActiveSheet
    fpath = "C:\Users	-tai\OneDrive\デスクトップ\図番\図番転記.xlsx"
    Set wb2 = Nothing
    For Each wb In Workbooks
        If wb.Name = "図番転記.xlsx" Then
            Set wb2 = wb
            Exit For
        End If
    Next
    If wb2 Is Nothing Then
        Set wb2 = Workbooks.Open(fpath)
    End If
    Set ws2 = wb2.Worksheets(1)
    ws2.Cells.ClearContents
    row2 = 1
    maxrow1 = ws1.Cells(Rows.Count, "C").End(xlUp).Row
    For row1 = 13 To maxrow1
        If ws1.Cells(row1, "A").Value = "○" Then
            ws2.Cells(row2, "A").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _
            ws1.Cells(row1, "O").Value & ws1.Cells(row1, "S").Value & ws1.Cells(row1, "U").Value & "*"
            row2 = row2 + 1
        End If
    Next
End Sub

tatsumaru77 · Answer

不明点です。
１．転記元のブックのシート名が不明です。
現在表示されているシート（アクティブシート）の内容を転記すれば良いですか？
２．図番転記.xlsxの転記先シート名が不明です。
一番、左側のシートへ転記すれば良いですか。
３．〇は、〇（漢数字）と○（記号）があります。
あなたが提示された〇は、左側の〇（漢数字）でしょうか。

エクセルvbaについて

>② maxrow1 = 500で実行するとできました。

>こちらも試してみましたが変わりません。

>頂いたコードを試してみましたが、やはり同じです。

前回のマクロは破棄してください。

>マクロ登録は転記元のブックで間違いありません。

もし、No4の

No3です。

>実行してみましたが、

No1です。

不明点です。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

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

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