コードの修正出来る方！

下記コードはExcelのページを追加するコードになっています。
"9:51"にデータが入った状態でページを追加した際、書式から値まですべてコピーされた状態でペーストされるのですが、これを書式と数式のみ貼付けとしたいです。

コードの修正出来ませんでしょうか(>_<)
よろしくお願いいたします。。



Sub ページを追加()

Dim myRange As Range
Dim Maxrow, i, j As Long

'データがあるセル範囲の最終行番号を取得
Set myRange = ActiveSheet.UsedRange
Maxrow = myRange.Row + myRange.Rows.Count - 1

'現在ページ数を計算
i = Application.RoundUp((Maxrow - 8) / 43, 0)

'ペーストを開始する行番号を計算
j = i * 43 + 9

Rows("9:51").Select
Selection.Copy

Rows(j).Select
ActiveSheet.Paste

End Sub

（こちらのサイトより引用させて頂いております。）

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

• すみません、デバッグなく動いたのですが、今度は罫線が消えてしまいました(:_;)
  罫線（書式）と数式の貼付けのコードを含めた状態で教えてほしいです(>_<)
  申しわけありません、、

  No.5の回答に寄せられた補足コメントです。 補足日時：2020/07/07 22:12

No.8 ベストアンサー 回答者： nekoronda 回答日時： 2020/07/07 22:53

失礼しました！！　バグがありました。

If Left(myRange.Value, 1) <> "=" Then
を
If Left(myRange.Formula, 1) <> "=" Then
に変更してください。

この回答へのお礼

昨日は遅い時間までお付き合い頂きありがとうございました。
無事成功しました(*^^*)
　
マクロが組めて羨ましいです。
ありがとうございましたm(__)m

お礼日時：2020/07/08 19:04

No.7 回答者： nekoronda 回答日時： 2020/07/07 22:35

？？？

現状のコードを全て公開してください。

この回答へのお礼

Sub ページを追加()

Dim myRange As Range
Dim Maxrow, i, j As Long

'データがあるセル範囲の最終行番号を取得
Set myRange = ActiveSheet.UsedRange
Maxrow = myRange.Row + myRange.Rows.Count - 1

'現在ページ数を計算
i = Application.RoundUp((Maxrow - 8) / 43, 0)

'ペーストを開始する行番号を計算
j = i * 43 + 9

Range("A9:P51").Select
Selection.Copy

Range("A" & j).PasteSpecial xlPasteAll

For Each myRange In Selection
If Left(myRange.Value, 1) <> "=" Then
myRange.Value = ""
End If

Next myRange

End Sub

このようになっています。
お願いしますm(__)m

お礼日時：2020/07/07 22:39

No.6 回答者： nekoronda 回答日時： 2020/07/07 22:20

Range("A9:H51").Select.Select　って

なんでSelectが２つ？

足りないじゃなくて多いです。

この回答へのお礼

すみません、私のミスでした(>_<)
補足にもコメントした通り無事動きましたが、罫線等も消えてしまいました。

対応出来ますでしょうかm(__)m

お礼日時：2020/07/07 22:32

No.5 回答者： nekoronda 回答日時： 2020/07/07 21:50

特に難しいことはありません。

行指定しているところを範囲指定してあげれば良いだけです。
例えばコピー対象がA列からH列なら

Rows("9:51").Select
を
Range("A9:H51").Select

Rows(j).PasteSpecial xlPasteAll
を
Range("A" & j).PasteSpecial xlPasteAll

に変更してください。

この回答へのお礼

分かりやすい解説ありがとうございます。

試してみたら
Range("A9:H51").Select.Selectのところでデバッグとなりました。
オブジェクトが必要とでています。

何か足りないのでしょうか(>_<)

お礼日時：2020/07/07 21:58

No.4 回答者： nekoronda 回答日時： 2020/07/07 21:01

それでしたら、１セルずつ数式か値かを判断する必要があります。

Rows(j).Select
ActiveSheet.Paste

の部分を以下に置き換えてください。

Rows(j).PasteSpecial xlPasteAll

For Each myRange In Selection
If Left(myRange.Value, 1) <> "=" Then
myRange.Value = ""
End If

Next myRange

ただ、上記だと遅いので出来れば行の指定だけではなく、列の指定もした方が良いです。

この回答へのお礼

出来ました(*^^*)
すごいですね！！
確かに時間かかりました笑
列に指定の仕方も教えてほしいです(>_<)

お礼日時：2020/07/07 21:24

No.3 回答者： nekoronda 回答日時： 2020/07/07 20:32

ん？

すいません、ちょっと勘違いしてたかも。
張り付け範囲内に”３”や"=3+1"など値と数式のセルが入り混じっていて、
"=3+1"だけコピーしたいということですか？

この回答へのお礼

はい。その通りです。計算式はそのままコピーしたいです。
説明不足ですみません(*_*;

よろしくお願いします。

お礼日時：2020/07/07 20:44

No.2 回答者： nekoronda 回答日時： 2020/07/07 20:04

Rows(j).Select

ActiveSheet.Paste

の部分を以下に置き換えてください。

Rows(j).PasteSpecial xlPasteAll
Selection.ClearContents

Rows("9:51").Select
Selection.Copy
Rows(j).PasteSpecial xlPasteFormats
Rows(j).PasteSpecial xlPasteFormulas

この回答へのお礼

これで罫線は残るようになりました(*^^*)
あと、セル内の値をクリアするようお願い出来ますか？

何度も申し訳ありません、、m(__)m

お礼日時：2020/07/07 20:21

No.1 回答者： nekoronda 回答日時： 2020/07/07 18:27

Rows(j).Select

ActiveSheet.Paste

の部分を以下に置き換えてください。

Rows(j).PasteSpecial xlPasteFormats
Rows(j).PasteSpecial xlPasteFormulas

この回答へのお礼

回答ありがとうございますm(__)m
試してみたところセルの値は全て貼付けされ、罫線も消えてしまっていました。。
　
改善できますでしょうか(>_<)？？

お礼日時：2020/07/07 19:47