会社名ごとにファイルを生成するVBAを作成したい

投稿者 : hotka     投稿日時 : 2024/12/02(Mon) 15:19:23     OS : Windows 11     EXCEL : Office 365

---

こんにちは

VBA初心者です。
いつも色々参考にさせていただいておりますが、質問を投稿するのは初めてです。

今回ご相談したいのは、[取引予定]シートに載っている情報を会社名ごとに新規ファイルを生成したいというものです。
[取引予定]シートには1年分の取引予定が載っていますが、2か月ごとにフィルターをかけている(11月の場合は11月と12月が可視化されている)のでこのフィルターも維持したままにしたく、[取引予定]シート以外にも7シートあり、このシートも一緒に生成したいです。


[取引予定]シートはA～BA列まで存在しますが、会社名はH列、日付はD列になります。


流れとしては

　　　　　　　　　　　 ファイル名
元ファイル(取引先3件)→【A会社】取引予定表.xlsx
　　　　　　　　　　 →【B会社】取引予定表.xlsx
　　　　　　　　　　 →【C会社】取引予定表.xlsx

元ファイルには数式も入っているため、ファイル生成後は全シート値貼りになっているのが理想です。

文章だけのご質問で大変恐縮ですが、ご助力をいただければと思います。
よろしくお願いいたします。

投稿者 : hotka     投稿日時 : 2024/12/02(Mon) 15:26:32

---

追記です。

ネットで色々調べて、以下のようなコードを記述してはおりますが、
こちらですと[取引予定]シートの分割に成功はしております。
ここから別シート追加や全シートの値貼りをどうやってよいかわからない状況です。

Sub 会社分割()

Application.ScreenUpdating = False

ChDir ThisWorkbook.Path

基準列 = 8
開始行 = 2
最終行 = ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Count).Row

For i = 最終行 To 開始行 Step -1

ファイル名 = "【" & Cells(i, 基準列).Value & "】取引予定表.xlsx”

If Dir(ファイル名) = “” Then

ActiveSheet.Copy
ターゲット = Cells(i, 基準列).Value

For d = 最終行 To 開始行 Step -1
If Cells(d, 基準列).Value <> ターゲット Then Rows(d).Delete
Next d

ActiveWorkbook.SaveAs ファイル名
ActiveWorkbook.Close

End If

Next i

Application.ScreenUpdating = True

End Sub

よろしくお願いいたします。

投稿者 : さんこう     投稿日時 : 2024/12/02(Mon) 16:05:21

---

＞別シート追加や全シートの値貼りをどうやってよいかわからない


「別シート追加」ではなく、最初からすべてのシートをコピーしてしまえばよろしいかと思います。

＜vba 全シート コピー＞
https://www.google.com/search?q=vba+%E5%85%A8%E3%82%B7%E3%83%BC%E3%83%88+%E3%82%B3%E3%83%94%E3%83%BC


＜vba 全シート 値貼付＞
https://www.google.com/search?q=vba+%E5%85%A8%E3%82%B7%E3%83%BC%E3%83%88+%E5%80%A4%E8%B2%BC%E4%BB%98