複数シート一括作成後に、特定範囲の数式は値で貼り付けしたい

下記は
フォーマットというシートをコピーして、
管理者というシートのＡ列のセル名から一括でシート名にしていくＶＢＡです。

Sub 管理者()

Dim Data As Worksheet
Dim ws As Worksheet
Dim i As Long
Dim LastRow As Long

Set Data = Sheets("管理者")
Data.Select

LastRow = Data.Cells(Rows.Count, 2).End(xlUp).Row

Application.ScreenUpdating = False

For i = 2 To LastRow

Sheets("フォーマット").Copy Before:=Data
ActiveSheet.Name = Data.Cells(i, 2)
Set ws = ActiveSheet

ws.Range("B1") = Data.Cells(i, 1).Value
ws.Range("B2") = Data.Cells(i, 2).Value
ws.Range("B3") = Data.Cells(i, 3).Value

ws.Range("D1") = Data.Cells(i, 4).Value
ws.Range("D2") = Data.Cells(i, 5).Value
ws.Range("D3") = Data.Cells(i, 6).Value
ws.Range("D4") = Data.Cells(i, 7).Value
Next i

Application.ScreenUpdating = True


End Sub




フォーマットというシートには数式が入っています。
シート作成後に、下記範囲の数式は値で貼り付けしたいのですがどのようにすればよいでしょうか。


値で貼り付けしたいセル範囲
A1:P4
A44:B46
A48:B50


ご教授いただければ幸いです。
宜しくお願い致します。

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2022/10/07 12:34

＃１　です

間違ってしまいました
ws.Range("B1").Resize(3).Value = Data.Cells(i, 1).Resize(3).Value
ws.Range("D1").Resize(4).Value = Data.Cells(i, 4).Resize(4).Value
ご質問部分でないので忘れて頂くか、下記のように訂正します

ws.Range("B1").Resize(3).Value = Application.Transpose(Data.Cells(i, 1).Resize(, 3).Value)
ws.Range("D1").Resize(4).Value = Application.Transpose(Data.Cells(i, 4).Resize(, 4).Value)

あと、: P4などの変な半角スペースも削除して・・・

この回答へのお礼

ありがとうございます、やりたいことができました
結合してたせいか、うまくいかなかったので下記のようにしました

'値で貼り付ける
ws.Range("A1:R8").Value = ws.Range("A1:R8").Value
ws.Range("A44:B46").Value = ws.Range("A44:B46").Value

お礼日時：2022/10/07 14:44

No.3 回答者： Qchan1962 回答日時： 2022/10/07 15:18

>結合してたせいか・・

なるほど、取敢えず良かったです

>そうなんです、同名シートがある場合があるので、最初に消しています
範囲にある値の　シートを削除するコードなどを加える事も可能かと・・

ただ、同名でないシートがどんどん増える状況が困るなら
管理者シートと　例えばフォーマットシートの間のシートを
インデックスですべて削除するコードとか・・・
要件、使用によって変わってくるところですね

実行ブックでなく新規ブックにシートを出力、作るとか、
シート別に別ブックを作るとか・・なんて方法も考えられますね

もし加える又は要件を変更するなどで判らなく躓いた時は
私などより高いスキルの方がいらっしゃいますので良いアドバイスをしてくれると思います。また質問を建ててください

No.1 回答者： Qchan1962 回答日時： 2022/10/07 11:50

こんにちは

ご質問を間違って解釈していたら忘れてください

Sheets("フォーマット").Copy Before:=Data
ActiveSheet.Name = Data.Cells(i, 2)
Set ws = ActiveSheet
ws.Range("A1: P4,A44: B46,A48: B50").Value = ws.Range("A1: P4,A44: B46,A48: B50").Value
ws.Range("B1").Resize(3).Value = Data.Cells(i, 1).Resize(3).Value
ws.Range("D1").Resize(4).Value = Data.Cells(i, 4).Resize(4).Value

ちなみにないとは思いますが
ActiveSheet.Name = Data.Cells(i, 2)
同名シートがあるとエラーになりそうですね・・・

この回答へのお礼

ActiveSheet.Name = Data.Cells(i, 2)
そうなんです、同名シートがある場合があるので、最初に消しています

お礼日時：2022/10/07 14:45