【マクロ】セルの塗りつぶし色をbook1からbook2へ転記したい

【やりたい事】
book1のセルA1からG7までの７つのセルをbook2の台帳へ転記したい。
⇒は、以下コードでできています

さらに

転記元のbook1セルA1からG7の
G7は、黄色の塗りつぶしセル。値はありません。
この黄色の塗りつぶしセルも一緒に転記をしたいです。

７つのセルの値だけの場合は、転記できています


よろしくお願いします


Sub 別ブックへ転記()


【コード：動きます】※本サイトにて教授いただき、作成しました
Dim ws1 As Worksheet

Dim wb2 As Workbook

Dim ws2 As Worksheet


Dim maxrow2 As Long

Dim row2 As Long

Dim i As Integer




Set ws1 = Worksheets("Sheet1") '転記元シート。開いているシート。




For i = 1 To Workbooks.Count

If Workbooks(i).Name = "book2.xlsx" Then

Set wb2 = Workbooks(i) '転記先のブック。

End If

Next




Set ws2 = wb2.Worksheets("Sheet1") '転記先のブック。シート




maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row '転記先のブックi列


row2 = maxrow2 + 1

ws2.Cells(row2, 1).Resize(1, 7).Value = ws1.Range("A1").Resize(1, 7).Value '転記元から転記先へ7セル分を転記.a1から７セル分。天気先。１列目から。



wb2.Save '転記先のブックを上書き


End Sub

質問者からの補足コメント

• 丸ごとコピーの上→転記ですね
  サワタケさんのを参考にしました
  以下で、良いでしょうか？？？
  
  ws2.Cells(row2, 1).Resize(1, 7) = ws1.Range("A1").Resize(1, 7).copy

  No.1の回答に寄せられた補足コメントです。 補足日時：2023/09/27 12:17

No.3 ベストアンサー 回答者： ssawatake 回答日時： 2023/09/27 14:02

>>以下で、良いでしょうか？？？

>>ws2.Cells(row2, 1).Resize(1, 7) = ws1.Range("A1").Resize(1, 7).copy

2個間違ってるので駄目です

1個目
copyメソッドなので、=では駄目です。=のところは半角スペースです。
=にすると、真偽値が転記。（TRUEとかFALSE)

2個目
AをBにコピーする時は、A.copy B です。
B A.copyとやると、文法エラーとなります。

ws1.Range("A1").Resize(1, 7).copy ws2.Cells(row2, 1).Resize(1, 7)
が正しいです。

この回答へのお礼

ありがとうございます

コピーメソッドなんですね
代入と勘違いしてました

ありがとうございます
Excel利用環境になりましたら
すぐに、試したいと思います

お礼日時：2023/09/27 14:05

No.4 回答者： fujillin 回答日時： 2023/09/27 21:08

No2です。

＞1.Range("A1048576")は、どういう意味でしょうか？
シートの最大行数が1048576なので、Ａ列の最終セルの意味です。

＞2.book2.xlsxが開いていない時のコードは、以下部分ですか？
「開いていない時」というわけではありません。
開いている時もその処理を通りますので・・
その部分としては、「ブックが開いているかをチェックして、開いていなければメッセージを出す」といった感じです。

No.2 回答者： fujillin 回答日時： 2023/09/27 11:58

こんにちは

＞book1のセルA1からG7までの７つのセルをbook2の台帳へ転記したい。
A1:G7だと、セル数は47ありますけれど？

＞G7は、黄色の塗りつぶしセル。値はありません
雰囲気から、G1セルの間違えと勝手に解釈しました。

＞この黄色の塗りつぶしセルも一緒に転記をしたいです。
背景色をコピーしたいという意味と解釈しました。

その他、不明な点は以下のように勝手に解釈しました。
　・転記元のブックに当該マクロが記載されている
　・転記するのはA1:G1の1行分の7セル
　・転記先シートの最終行はA列で判断してよい
　　（＝A列が空であることはない）
　・書式をコピーするのはG7セルのみで、背景色以外の書式はコピーしない


Sub Sample()
Dim sRange As Range, dRange As Range

Set sRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:G1")

On Error Resume Next
Set dRange = Workbooks("book2.xlsx").Worksheets("Sheet1").Range("A1048576")
If Err.Number <> 0 Then MsgBox "転記先ブックが開いていません": Exit Sub
On Error GoTo 0

Set dRange = dRange.End(xlUp).Offset(1).Resize(1, 7)
dRange(7).Interior.Color = sRange(7).Interior.Color
dRange.Value = sRange.Value
End Sub

この回答へのお礼

コードの教授ありがとうございました。
しっかりと動きました。

２つ質問ですが

1.Range("A1048576")は、どういう意味でしょうか？

2.book2.xlsxが開いていない時のコードは、以下部分ですか？

On Error Resume Next
Set dRange = Workbooks("book2.xlsx").Worksheets("Sheet1").Range("A1048576")
If Err.Number <> 0 Then MsgBox "転記先ブックが開いていません": Exit Sub
On Error GoTo 0

お礼日時：2023/09/27 18:47

No.1 回答者： ssawatake 回答日時： 2023/09/27 11:42

値のみを転記してるから、値のみになります。

丸ごとコピーすれば良いのでは？

ws2.Cells(row2, 1).Resize(1, 7).Value = ws1.Range("A1").Resize(1, 7).Value

↓

ws1.Range("A1").Resize(1, 7).copy ws2.Cells(row2, 1).Resize(1, 7)

この回答へのお礼

コピーメソッドにて、セルの塗りつぶしを、転記できました。ありがとうございます。

お礼日時：2023/09/27 18:48