EXCEL VBA 数式を含めたコピー貼り付け

質問

お世話になります。

こちらのサイト内にありました、以前の質問QNo.8966520に対する以下の回答（http://qa.itmedia.co.jp/qa8966520.html）を参考にしているところですが、このVBAでは、A列に入っているデータ毎に新規ファイルを作成・保存するような処理となっているようですが、仮にデータを分類する基準を現在のA列を基準としたものから、B列にする場合は、どの記述をどのように変更すればよろしいでしょうか。

これに加えての質問ですが、仮にA.xlsｘという元ブックがあると仮定し、この中に[データ]と[単価]という2つのシートがあるとします。以下のVBAの記述では[データ]シートのデータをA列ごと分類し、それを新規ブックに保存させるものですが、これに合わせて[単価]シートのデータ（シート内のデータは加工の必要なし）も新たに作成するブックにコピーし、保存するには、どのような記述を追加すればよろしいでしょうか。最終的には、新規作成ブックに、[データ]と[単価]の2つのシートが作成されるようにしたいと思います。

[単価]シートのデータを、[データ]シートのデータと合わせて新規ブックにコピーする目的は、[データ]シートのデータの一部に、[単価]シートのデータを参照する数式が入っており、[作業用]シートのデータの抽出・保存だけでは、[作業用]シート内の数式が不完全な状態となってしまうためです。

どなたかご教授いただけますでしょうか？
よろしくお願い致します。

Sub sample()
Dim s0, nwk As Worksheet
Dim h
Dim i, j, LastRow, cnt As Long

Application.DisplayAlerts = False

Worksheets("データ").Copy before:=Worksheets(1)
Set s0 = Worksheets(1)

Do Until Application.CountA(s0.Range("A:A")) < 2
h = s0.Range("A2").Value

'検索ワードの変数hと同じ文字のセル数取得
cnt = WorksheetFunction.CountIf(s0.Range("A:A"), h)
i = cnt + 1

With s0
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = h
End With

Set nwk = Worksheets(h)

'データシートのA列の最終行取得
LastRow = s0.Cells(Rows.Count, 1).End(xlUp).Row
j = LastRow

'1行目コピー
s0.Range("A1:C1").Copy nwk.Range("A1")

Do Until j = 1
'A列のセルデータが変数hと同じ場合コピペ及び行削除
If s0.Cells(j, 1).Value = h Then
s0.Range("A" & j & ":C" & j).Copy nwk.Range("A" & i)
i = i - 1
s0.Rows(j).Delete
End If

j = j - 1
Loop

With nwk
.Move
ActiveWorkbook.SaveAs Filename:="C:\dumy\" & h & ".xlsx"
ActiveWorkbook.Close False
End With

Loop
s0.Delete

Application.DisplayAlerts = False
MsgBox "データをEXCELに表示します。"

End Sub

回答No.1

ushi2015 · ベストアンサー

こんにちは
全くの新規で必要条件を全て提示して質問し直した方がいいかと思います。
このコードは酷すぎて治す気になれません。

お礼

ushi2015さん

　早速，ご回答いただきありがとうございました。

　既に，どなたかがお答えになったコードだったもので。。。当方の勉強不足で申し訳ございません。

　ご指摘のとおり，改めて質問し直すことにさせて頂きます。

　その際には，何卒ご教授のほど，よろしくお願いします。