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
お礼
早速の回答ありがとうございます 大変助かりました