エクセルvbaについて

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

No.10 ベストアンサー 回答者： tatsumaru77 回答日時： 2024/02/25 13:54

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

>これでも大丈夫ですけど。

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

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

この回答へのお礼

承知いたしました。
今回もありがとうございました。

お礼日時：2024/02/25 14:00

No.9 回答者： tatsumaru77 回答日時： 2024/02/25 12:27

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

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

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

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

この回答へのお礼

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

お礼日時：2024/02/25 13:21

No.8 回答者： tatsumaru77 回答日時： 2024/02/25 12:07

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

>エラーコード1004が出ます。
>何度もやってみましたがダメでした。

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

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

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

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

この回答へのお礼

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

お礼日時：2024/02/25 12:22

No.7 回答者： tatsumaru77 回答日時： 2024/02/25 11:17

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

こちらを、標準モジュールに登録してください。

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\t-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

この回答へのお礼

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

お礼日時：2024/02/25 11:56

No.6 回答者： tatsumaru77 回答日時： 2024/02/25 11:14

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

　
>シートも最前面、1番左のシートです。

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

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

No.5 回答者： tatsumaru77 回答日時： 2024/02/25 11:02

もし、No4の

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

この回答へのお礼

Sheet1です。

お礼日時：2024/02/25 11:06

No.4 回答者： tatsumaru77 回答日時： 2024/02/25 10:56

No3です。

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

この回答へのお礼

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

お礼日時：2024/02/25 11:04

No.3 回答者： tatsumaru77 回答日時： 2024/02/25 10:37

>実行してみましたが、

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

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

この回答へのお礼

転記元シ－トは最前面に表示されている状態で実行しています。
転記するファイルは正常に開かれます。

お礼日時：2024/02/25 10:53

No.2 回答者： tatsumaru77 回答日時： 2024/02/25 08:59

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\t-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

この回答へのお礼

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

お礼日時：2024/02/25 10:31

No.1 回答者： tatsumaru77 回答日時： 2024/02/25 08:35

不明点です。

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

この回答へのお礼

回答ありがとうございます。
1.現在表示のシートで大丈夫です。
2.1番左のシートで大丈夫です。
3.記号の◯です。
よろしくお願いします。

お礼日時：2024/02/25 08:53