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も見ています
-
性格の違いは生まれた順番で決まる?長男長女・中間子・末っ子・一人っ子の性格の傾向
同じ環境で生まれ育っても、生まれ順で性格は違うものなのだろうか。家庭教育研究家の田宮由美さんに教えてもらった。
-
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
Excelで画像URLを1つずつセルに振り分けたい
Visual Basic(VBA)
-
7
csvファイルを列数ごとに分割するExcelマクロが書けずに困っています
Visual Basic(VBA)
-
8
VBAのコードを教えてください
Visual Basic(VBA)
-
9
ユーザーフォームに別シートからデータを反映させたい。
Visual Basic(VBA)
-
10
ExcelのVBAのことで質問です。 以下のコードを入れ、ボタンを押せば作動させると写真のように画面
Visual Basic(VBA)
-
11
excelのVBAについて、以下のコードに追加をお願いいたします。
Visual Basic(VBA)
-
12
ExcelVBAのFindFirstエラーについて
Visual Basic(VBA)
-
13
Excel VBA マクロ あるフォルダー内の複数のファイルを統合したいです
Visual Basic(VBA)
-
14
VBA 別ブックから条件に合うものを転記したいです
Visual Basic(VBA)
-
15
Excel 大なり小なりを表すとき、 例えば「10以上」なら、>=10 と表せますが、 この10の部
Excel(エクセル)
-
16
10行目にフィルターを使用して見出しがあります。列はA:DFで11行目以降(2000行ぐらい)はデー
Visual Basic(VBA)
-
17
エクセルファイルのデータ転記について
Visual Basic(VBA)
-
18
Excel VBA 文字列のセルを反映させたいです
Visual Basic(VBA)
-
19
VBAのコードを教えてください
Visual Basic(VBA)
-
20
ExcelのVBAコードについて教えてください。
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
B列の最終行までA列をオート...
-
VBAで指定範囲内の空白セルを左...
-
targetをA列のセルに限定するに...
-
VBAのコードを教えてください
-
VBscriptでExcel sheetの並び替...
-
vba 2つの条件が一致したら...
-
エクセルVBAにて =A1=B1とすれ...
-
VBAコンボボックスで選択した値...
-
JTableの行の幅設定
-
VBA とびとびの列を結合させる
-
Changeイベントでの複数セルの...
-
VBマクロ 色の付いたセルを...
-
スプレッドシートのデータをGAS...
-
VBA。壁の間隔Xミリの中に、5...
-
Excel 複数列から語句を含む行...
-
エクセル マクロ 後列から条件...
-
Excelで、あるセルの値に応じて...
-
VBA 何かしら文字が入っていたら
-
特定の条件に合致したセルを別...
-
Excel VBA 足し算の問題を自動...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Worksheets メソッドは失敗しま...
-
Cellsのかっこの中はどっちが行...
-
VBAのコードを教えてください
-
VBAを使って検索したセルをコピ...
-
B列の最終行までA列をオート...
-
エクセルvbaについて
-
vba 2つの条件が一致したら...
-
Excelで、あるセルの値に応じて...
-
VBA UserFormからの転記で
-
VBAのFind関数で結合セルを検索...
-
文字列の結合を空白行まで実行
-
IIF関数の使い方
-
VBA 何かしら文字が入っていたら
-
マクロ 最終列をコピーして最終...
-
Changeイベントでの複数セルの...
-
エクセルVBAにて =A1=B1とすれ...
-
【VBA】2つのシートの値を比較...
-
データグリッドビューの一番最...
-
VBマクロ 色の付いたセルを...
-
VBAで指定範囲内の空白セルを左...
おすすめ情報