tatsumaru77様
以前投稿した内容で転記の追加をしたいのですが、内容は別ファイルへの転記をB列の1行目から添付の内容をお願いします。A列の転記内容はそのままでいいです。
AA0000Z00001*
B列にはS列とU列の転記はなしです。
それとこのコードだと転記した後に、もう一度転記処理を行うと最初に転記したものが消えてしまいます。一度転記したものは消さずにその下から転記されるようにしたいです。A列B列も同じようにです。
自分で変更してみましたが、うまくいきません。
申し訳ありませんが、よろしくお願いいたします。
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
or row1 = 13 To maxrow1
If ws1.Cells(row1, "A").Value = "○" Then
ws2.Cells(row2, "B").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _
ws1.Cells(row1, "O").Value & "*"
row2 = row2 + 1
End If
Next
End Sub
No.6ベストアンサー
- 回答日時:
>If ws1.Cells(row1, "A").Value <> "" Thenに変更しましたが、変わりはないです。
そうすると、そのマクロ自体が実行されていないように見えます。
1.A列の13行目(A13)に〇を設定する。
2.下記行にブレイクポイントを設定する。
If ws1.Cells(row1, "A").Value <> "" Then
3.マクロを実行する。
4.If ws1.Cells(row1, "A").Value <> "" Then
の行で止まることを確認する。
5.F8でステップ実行する。
6.その後、どうなりますか。
①ws2.Cells(row2, "A").Value = ws1.Cells 以下省略が実行される。
②上記の①は実行されない。
上記①②のどちらでしょうか。
申し訳ありません。
maxrow1 = 500の部分を20に変更してみると転記され、再度500に戻しても転記されました。余分なスペースがあったのでしょうか?
とりあえずできましたので、ありがとうございます。時間を取らせてしまい申し訳ありませんでした。
No.5
- 回答日時:
不思議ですね。
確認1:
13行目のA列に○があるのに、
ws2.Cells(row2, "A").Value = ws1.Cells(row1, "C").Value 以下省略
が実行されない。
確認3:
If ws1.Cells(row1, "A").Value = "○" Then の○を
13行目のA列にコピペしても、変わらず。
上記で、通常は、転記条件が成立するはずでが、何らかの原因で
転記条件が成立しないようです。
A列が、○と空欄しかないという前提になりますが、
If ws1.Cells(row1, "A").Value = "○" Then の行を
If ws1.Cells(row1, "A").Value <> "" Then
に変えて実行してください。それで、どうなりますか。
それで、転記されるなら、A列の○が違っているか、A列の○の前後にスペースなどがあるかなどが考えられます。
No.4
- 回答日時:
>頂いたコ-ドをを実行すると転記される側のファイルが開かれるのですが、>何も転記されません。
特にエラーになるわけでもないのですが。考えられるのは、何かの原因により転記元のデータが転記対象になっていない。
ということです。
確認1:
当然の話ですが、転記元シート(Sheet1)の13行目以降に、
A列に○のついた行があるという前提です。
もし、ないなら、転記されません。
確認2:
①maxrow1 = 500
②maxrow1 = ws1.Cells(Rows.Count, "C").End(xlUp).Row
のどちらを採用していますか?
もし、②を採用しているなら、①に変えてください。
確認3:
転記元の○が、提示したマクロの
If ws1.Cells(row1, "A").Value = "○" Then
の○と同じか確認してください。
マクロの○を転記元のA列にコピペしてから、マクロを実行すれば
必ず一致します。
上記の確認を行ってください。
確認1:転記元シート(Sheet1)の13行目以降に、
A列に○のついた行はありますが、一行ずつコードを動かすと下記のコードがスル-されます。
A列の13行目以降に〇があればここは実行されますよね?
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
ws2.Cells(row2, "B").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _
ws1.Cells(row1, "O").Value & "*"
row2 = row2 + 1
確認2:
①maxrow1 = 500
②maxrow1 = ws1.Cells(Rows.Count, "C").End(xlUp).Row
①を使用しています。元々①から変更していません。
確認3:
転記元の○が、提示したマクロの
If ws1.Cells(row1, "A").Value = "○" Then
の○と同じか確認してください。
マクロの○を転記元のA列にコピペしてから、マクロを実行すれば
必ず一致します。
コピペして実行してみましたが変わりないです。
No.2
- 回答日時:
失礼しました。
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 = 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)
row2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
If ws2.Cells(row2, "A").Value <> "" Then
row2 = row2 + 1
End If
maxrow1 = 500
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 & "*"
ws2.Cells(row2, "B").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _
ws1.Cells(row1, "O").Value & "*"
row2 = row2 + 1
End If
Next
End Sub
申し訳ございません。
maxrow1 = 500を一度20に変更してみたら転記できました。
その後500に戻しても実行できたので問題ありません。
時間を取らせてしまい申し訳ありませんでした。
ありがとうございます。
No.1
- 回答日時:
前回のは破棄してください。
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"
fpath = "D:\goo\data9\図番転記.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)
row2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
If ws2.Cells(row2, "A").Value <> "" Then
row2 = row2 + 1
End If
maxrow1 = 500
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 & "*"
ws2.Cells(row2, "B").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _
ws1.Cells(row1, "O").Value & "*"
row2 = row2 + 1
End If
Next
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBA 別ブックからの転記の高速化について VBA 別ブックからの転記の高速化についてご教授下さい。 19 2022/07/26 13:07
- Visual Basic(VBA) VBAコードが作動しません。修正したいのですが何処に原因かあるか教えて下さい。 1 2024/01/08 16:23
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) 【VBA】特定のワードが入っている行全体を塗りつぶしたい 4 2022/04/20 15:22
- Visual Basic(VBA) vbaを早くしたい 5 2022/09/09 10:58
- Visual Basic(VBA) エクセルVBAで教えて頂きたいのですが? 2 2022/12/31 20:28
- Visual Basic(VBA) VBA初心者です。 2 2022/10/10 11:52
- Excel(エクセル) 【マクロ】違うフォルダにあるファイルから、転記するには? 4 2023/09/26 19:49
- Visual Basic(VBA) 引数に数値、文字列の混在 1 2024/01/31 09:44
- Excel(エクセル) 【マクロ】セルの塗りつぶし色をbook1からbook2へ転記したい 4 2023/09/27 10:50
このQ&Aを見た人はこんなQ&Aも見ています
-
新NISA制度は今までと何が変わる?非課税枠の拡大や投資対象の変更などを解説!
少額から投資を行う人のための非課税制度であるNISAが、2024年に改正される。おすすめの銘柄や投資額の目安について教えてもらった。
-
for 文の 繰り返し処理に使えるのかどうかについて
Visual Basic(VBA)
-
エクセルVBAの配列について
Visual Basic(VBA)
-
VBAコードについて
Visual Basic(VBA)
-
-
4
VBAの質問です、複数のテキストボックスに同じコメントを
Visual Basic(VBA)
-
5
Excel VBA マクロ シート名を変えずにA列にあるセル名の名前でファイルの分割をしたいです
Visual Basic(VBA)
-
6
csvファイルを列数ごとに分割するExcelマクロが書けずに困っています
Visual Basic(VBA)
-
7
VBAのコードを教えてください
Visual Basic(VBA)
-
8
ユーザーフォームに別シートからデータを反映させたい。
Visual Basic(VBA)
-
9
ExcelVBAのFindFirstエラーについて
Visual Basic(VBA)
-
10
エクセルファイルのデータ転記について
Visual Basic(VBA)
-
11
配列のペースト出力結果の書式について
Visual Basic(VBA)
-
12
エクセルのマクロについて教えてください。
Visual Basic(VBA)
-
13
10行目にフィルターを使用して見出しがあります。列はA:DFで11行目以降(2000行ぐらい)はデー
Visual Basic(VBA)
-
14
Excelで画像URLを1つずつセルに振り分けたい
Visual Basic(VBA)
-
15
VBA 別ブックから条件に合うものを転記したいです
Visual Basic(VBA)
-
16
Excel VBA 文字列のセルを反映させたいです
Visual Basic(VBA)
-
17
VBAのコードを教えてください
Visual Basic(VBA)
-
18
VBA UserFormからの転記で
Visual Basic(VBA)
-
19
VBA 二つのブックをうまく扱えないでいます
Visual Basic(VBA)
-
20
月ごとに作成している日報ファイルを、VBAでコピーし日付ごとのシートにしたい
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
文字列の結合を空白行まで実行
-
vba 2つの条件が一致したら...
-
VBAを使って検索したセルをコピ...
-
データグリッドビューの一番最...
-
URLのリンク切れをマクロを使っ...
-
IIF関数の使い方
-
【VBA】2つのシートの値を比較...
-
B列の最終行までA列をオート...
-
エクセル 2つの表の並べ替え
-
DataGridViewに空白がある場合...
-
Cellsのかっこの中はどっちが行...
-
VBAで、離れた複数の列に対して...
-
VBAのFind関数で結合セルを検索...
-
マクロ 最終列をコピーして最終...
-
期限を超えた日付に警告のメッ...
-
vbaでシートより100より大きい...
-
VBA初心者です 検索した数字の...
-
Changeイベントでの複数セルの...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
B列の最終行までA列をオート...
-
vba 2つの条件が一致したら...
-
Cellsのかっこの中はどっちが行...
-
VBAを使って検索したセルをコピ...
-
VBAのFind関数で結合セルを検索...
-
文字列の結合を空白行まで実行
-
IIF関数の使い方
-
【VBA】2つのシートの値を比較...
-
マクロ 最終列をコピーして最終...
-
Changeイベントでの複数セルの...
-
VBA 何かしら文字が入っていたら
-
URLのリンク切れをマクロを使っ...
-
エクセルVBAにて =A1=B1とすれ...
-
VBAでのリスト不一致抽出について
-
データグリッドビューの一番最...
-
マクロについて。S列の途中から...
-
VBA UserFormからの転記で
-
targetをA列のセルに限定するに...
おすすめ情報