転記マクロ

投稿者 : yoshi     投稿日時 : 2024/10/22(Tue) 21:47:17     OS : Windows 11     EXCEL : Office 365

---

別ブックからの転記マクロを作成しようとしています。
転記元ブックの特定の範囲から転記先へ自動で記入するようにしたいのですが、
For文の使い方がおかしいのか失敗してしまいます。
間違っている箇所を教えていただけると幸いです。
何卒宜しくお願い致します。

Sub 転記()
   
   Dim 転記元ブック As Workbook
   Dim 転記先ブック As Workbook
   Dim 転記元シート As Worksheet
   Dim 転記先シート As Worksheet
   Dim 転記元最終行 As Long
   Dim 転記先開始行 As Long
   Dim i As Long

   ' 転記元ブックを指定
   Set 転記元ブック = Workbooks("xxxx.xlsx")
   Set 転記元シート = 転記元ブック.Sheets("aaaa") ' 1枚目のシートを指定（シート名でも可）

   ' 転記先ブックを指定（このマクロが記載されているブック）
   Set 転記先ブック = ThisWorkbook
   Set 転記先シート = 転記先ブック.Sheets("bbbb") ' 1枚目のシートを指定

   ' 転記元シートの最終行を取得
   転記元最終行 = 転記元シート.Cells(Rows.Count, 2).End(xlUp).Row

　 ' 転記先の入力先を取得
   転記先開始行 = 転記先シート.Cells(Rows.Count, 9).End(xlUp).Row + 1

   ' 転記元シートのB列から転記先シートのI列にデータを転記（10行目から）
   For i = 10 To 転記元最終行
       ' B列のセルの背景色が「色なし」なら転記
       If 転記元シート.Cells(i, 2).Interior.Color = -4142 Then
       転記先シート.Cells(転記先開始行, 9) = 転記元シート.Cells(i, 2).Value

            Else
             
              MsgBox "失敗"

       End If
   Next i
   
End Sub

投稿者 : てらてら     投稿日時 : 2024/10/23(Wed) 05:49:03

---

こんにちは。

2つ指摘します。

> If 転記元シート.Cells(i, 2).Interior.Color = -4142 Then
背景色なしを判定するには、Interior.Color ではなく Interior.ColorIndex を使って、xlNone　と比較するのが常套手段です。

If 転記元シート.Cells(i, 2).Interior.ColorIndex = xlNone Then

どうしてもInterior.Color を使いたければ、背景色なしのセルを以下のようなコードで探りましょう。
Debug.Print 転記元シート.Cells(i, 2).Interior.Color

If 転記元シート.Cells(i, 2).Interior.Color = 16777215 Then '(あまり見かけませんが,,,)



2つ目ですが、転記先のセルをインクリメントしないと、同じ場所に転記されて意味がありません。

転記先シート.Cells(転記先開始行, 9) = 転記元シート.Cells(i, 2).Value
転記先開始行 = 転記先開始行 + 1 'インクリメント

参考にしてください。

投稿者 : ピロリ     投稿日時 : 2024/10/23(Wed) 06:18:04

---

１つ目のセル色判定の件は、てらてらさん の仰る通り。

２つ目の転記先行の件は、転記先行を取得し直すっていうのも有りかもですね。
　転記先開始行 = 転記先シート.Cells(Rows.Count, 9).End(xlUp).Row + 1　　'毎回、取得し直して、
　転記先シート.Cells(転記先開始行, 9) = 転記元シート.Cells(i, 2).Value　'転記する。

投稿者 : yoshi     投稿日時 : 2024/10/23(Wed) 12:14:24

---

てらてらさん、ピロリさん、指摘いただいたとおり修正すると上手く動きました。
丁寧に教えていただきありがとうございます。