VBAの作成方法について

質問

マクロ初心者です。
エクセルの値のコピペに時間がかかっているため、マクロを使って自動化させたいと思っています。
どなたかソースを教えていただけますでしょうか？
＜内容＞
　・「実績データ」という名前のエクセルデータに値を貼付けさせたい。
　　シート構成は「140」「540」といった部門コード名のシートが複数あります。
　・値を持っている別エクセルデータは「実績データ140」と最後に部門コード3桁をつけた名前になります。
　・「実績データ140」のデータを「実績データ」のシート140にそのデータを貼付けしたい。
　・なお、「実績データ140」ファイルのシート名は140です。

回答No.1

NuboChan

その「エクセルデータ」がどこにあってどこに読み込むのかも記載されていないので
とりあえずたたき台の参考コードです。

（なお、このコードは検証していません。）

完全に正しいとは保証できません。自己責任でご利用ください。

希望と異なる仕様ならもう少し情報を上げてください。

このコードは、エクセルファイル（A)のシート1のA列からB列までのデータを読み込み、
A列の値の先頭3桁と同じ名前のシートがあるエクセルファイル（B)にB列の値を書き込むものです。

エクセルファイル（B)に同じ名前のシートがない場合は、新しく作成します。
エクセルファイル（A)と（B)は同じフォルダに保存されているものとします。

Sub test()
Dim wbA As Workbook 'エクセルファイル（A)
Dim wbB As Workbook 'エクセルファイル（B)
Dim wsA As Worksheet 'エクセルファイル（A)のシート1
Dim wsB As Worksheet 'エクセルファイル（B)の書き込み先シート
Dim rngA As Range 'エクセルファイル（A)の読み込み範囲
Dim rngB As Range 'エクセルファイル（B)の書き込み範囲
Dim i As Long 'ループカウンタ
Dim sheetName As String 'シート名

'エクセルファイル（A)と（B)を開く
Set wbA = Workbooks.Open(ThisWorkbook.Path & "\エクセルファイル（A).xlsx")
Set wbB = Workbooks.Open(ThisWorkbook.Path & "\エクセルファイル（B).xlsx")

'エクセルファイル（A)のシート1を取得
Set wsA = wbA.Worksheets(1)

'エクセルファイル（A)のA列からB列までの入力されている範囲を取得
Set rngA = wsA.Range("A1", wsA.Range("B1").End(xlDown))

'エクセルファイル（A)の読み込み範囲の行数分ループ
For i = 1 To rngA.Rows.Count
'A列の値の先頭3桁をシート名とする
sheetName = Left(rngA.Cells(i, 1).Value, 3)

'エクセルファイル（B)にシート名と同じシートがあるかチェック
On Error Resume Next 'エラーを無視する
Set wsB = wbB.Worksheets(sheetName) 'シートを取得
On Error GoTo 0 'エラー処理を元に戻す

'シートがない場合は新しく作成する
If wsB Is Nothing Then
Set wsB = wbB.Worksheets.Add 'シートを追加
wsB.Name = sheetName 'シート名を変更
End If

'エクセルファイル（B)の書き込み先シートの最終行の次の行を取得
Set rngB = wsB.Range("A" & wsB.Rows.Count).End(xlUp).Offset(1, 0)

'エクセルファイル（B)の書き込み先シートにB列の値をコピーする
rngB.Value = rngA.Cells(i, 2).Value

'シートオブジェクトを解放する
Set wsB = Nothing
Next i

'エクセルファイル（A)と（B)を保存して閉じる
wbA.Close True
wbB.Close True
End Sub
```

実際に動かす前には、模擬DATAを利用して正しく動作するか確認してください。

お礼

ご連絡遅くなりました。 こちらで一度作成してみます。 ありがとうございました。

Powered by GRATICA