質問: csvsheet.damy2_r.Find(What:="検索文字", lookat:=xlPart) ``` 不勉強で申し訳ありませんが、よろしくお願い致します。 説明不足の箇所がありましたら修正しますので、コメントをお願いします。
回答: 出来ましたので、共有します。 転記項目が複数ある場合、転記先と転記元に選択しているシートが切り替わるので画面がチカチカしますがそこは改善の必要がありそうです。 ですが、目的の処理がうまくいきました。 sageさん、コメントありがとうございます。 ``` 'シート1で「開始セル」を検索(完全一致) Set damy1 = sheet.Cells.Find(what:="開始セル", LookAt:=xlWhole) If Not damy1 Is Nothing Then damy1_ad = damy2.Offset(1, 0).Address(RowAbsolute:=False, _ ColumnAbsolute:=False) '「開始セル」文字列の1つ下のセル座標を変数に格納 Else Call MsgBox("セルが見つかりません") '「開始セル」文字列が無かった場合のエラー回避 End End If '繰り返し転記処理 Dim damy2_r As Range Set damy2_r = Range("A:A") '検索範囲をA列に設定する変数 Dim damy2_cell As Range '最初に検索にヒットしたセルを記録 Set damy2 = csvsheet.Cells.Find(what:="word", LookAt:=xlPart) '最初のFindで“word”という語を検索するように設定 If Not damy2 Is Nothing Then '検索対象が1件以上ある場合に下記コードを実行 Set damy2_cell = damy2 '最初のセルを格納する Do damy2_ad = damy2.Address(RowAbsolute:=False, _ ColumnAbsolute:=False) '検索したセルの座標を変換する csvsheet.Range(damy2_ad).Copy 'コピーする sheet.Range(damy1_ad).PasteSpecial Paste:=xlPasteValues '値のみを貼り付ける Application.CutCopyMode = False 'コピーを解除する damy1_ad = sheet.Range(damy1_ad).Offset(1, 0).Address( _ RowAbsolute:=False, _ ColumnAbsolute:=False) '貼り付けるセルの座標を1つ下にする Set damy2 = csvsheet.Cells.FindNext(damy2) '()内のセルの次のセルから検索を続行 Loop While damy2.Address <> damy2_cell.Address '最初のセルに戻るまでDo~Loopを継続 End If ActiveWorkbook.Close SaveChanges:=False 'csvファイルを閉じる(保存無し) ```