ExcelVBAの転記(1つのひな形へ複数シート)
お世話になります。ExcelVBAを少し学んだ程度の者です。
1つのExcelファイルに複数存在する個別のシートから、1つのひな形シートへ転記する方法に頭を悩ませております。イメージとしては名簿管理のようなものとご理解してください。
複数存在するシート(約200シート)には、項目名に対するデータ(例えば、名前や住所などが定められたセルに入力されています)が揃っておりますが、書式の変更によりひな形のシートへ転記する必要があります。
200ほどのシートには、M10セルには名前が、B15セルには住所、C16セルには電話番号が……という具合に入力されています。これらのデータをひな形シートでは、N5セルに名前、C13セルに住所、D14セルには電話番号などを転記する必要があります(セル番地は適当です)。
ひな形シートは1枚で、マクロを実行する際にひな形シートをコピーして(Xとします)、200ほどの個別のシート(A、B、C……)を転記しようと思っております。A、B、C……に入力された複数の値は項目別にCells(i,j).Valueを、XへCells(x,y).Valueへ転記すれば良いと考えておりましたが、上手くいきません。ひな形をコピーしたXのシートへ上手く転記ができず、Aを転記したシートばかりが量産され、B、C以降のシートへ制御が移っていないようです。恐らく、Workwsheetオブジェクトのカウンタ変数に問題があると思われます。
VBAのコードとしては下記のように記述しております。
Sub SheetCopy()
Application.ScreenUpdating = False
Dim cnt As Long 'シート数カウント変数
Dim i As Long 'シート用のカウンタ変数
Dim wb As Workbook 'コピー元
Dim ws1 As Worksheet 'コピー元
Dim ws2 As Worksheet 'コピー先
'1がコピー元で2がコピー先
cnt = Worksheets.Count 'シート数をカウント
i = 2
Set wb = Workbooks("転記用.xlsm")
Set ws1 = wb.Worksheets(i)
Set ws2 = wb.Worksheets("ひな形")
For i = 1 To cnt
ws2.Copy after:=Worksheets(i)
Set ws2 = wb.Worksheets(i)
ws2.Cells(2, 2).Value = ws1.Cells(2, 13).Value '名前
ws2.Cells(3, 2).Value = ws1.Cells(6, 10).Value '住所
以下、同様の転記処理を記述しています。
Next i
End Sub
上記のコードを、パッと見たところ、コピーはしているものの、転記先がコピー元になっているのも原因だと思います(コピー先へ転記する方法が現時点でわかりかねます……ここがネックだと考えております)。
ご知見のある方々から、アドバイスをいただけると幸いです。
どうぞ、よろしくお願い申し上げます。
お礼
★回答ありがとうございました★