マクロで、別ブックのデータを、既存ブックの一欄に

質問

マクロで以下のような操作をしたいと思っております。
どのようなコードを書けばよろしいでしょうか。ご教授ください。

【顧客データ一覧.xls】というブックのシート１に顧客データ一覧表があります。

同ブックのシート１上部にコマンドボタンを作成し、ボタン押下で以下のような操作を行いたい

１.ファイルダイアログを開いて、【顧客データひとり分.xls】というブックを選択

２．【顧客データひとり分.xls】に入力されているデータを、【顧客データ一覧.xls】の顧客データ一覧表の末尾に、コピーして追加・上書保存
顧客データひとり分はセル（3,4)に年齢が入力されている等、入力箇所は固定です。

３.顧客データひとり分.xlsは閉じて、更新された顧客データ一覧.xlsを表示させる

よろしくお願いいたします。マクロは作成したことがありますが、何年もブランクがあり、かなり忘れてしまいました・・・。
と、エクセル2003以来久しぶりに操作ですので、エクセルそのものに大変戸惑っております。。。実力不足でお恥ずかしいのですが、お力をお借りできれば幸いです。

回答No.2

hallo-2007 · ベストアンサー

こんな感じでしょうか
Sub ボタン1_Click()
On Error GoTo Er

With ThisWorkbook.Sheets("シート１") '元のブックの出荷データを使うので　Withで指定しておく
Workbooks.Open Filename:=ThisWorkbook.Path & "\顧客データひとり分.xls" 'このファイルと同じフォルダーにある顧客データひとり分のファイルを開く
Sheets("シート１").Select '準備しておいたシートに移動

GYOU = .Range("A" & Rows.Count).End(xlUp).Row + 1 'このブックの最後の行を取得
.Range("A" & GYOU & ":C" & GYOU + 4).Value = Range("A2:C6").Value '注文書のデータを入れる
ActiveWorkbook.Close '顧客データひとり分のファイルを閉じる

End With
Kill ThisWorkbook.Path & "\顧客データひとり分.xls" '顧客データひとり分のファイルを削除
Exit Sub
Er:
MsgBox "ファイルが存在しないか、その他のエラーが発生しました。"
End Sub

コピーするセルは4A2~C6としています。

補足

ありがとうございました。
下記のような汚いソースになってしまいました。。

ここには項目を１０個しか書いていませんが、実際には７０個あり、
ソースが縦に長々と続いています。

これらをスッキリさせることは可能でしょうか？？

Sub ボタン1_Click()

With ThisWorkbook.ActiveSheet
GYOU = .Range("A" & Rows.Count).End(xlUp).Row + 1 '
End With

Dim OpenFileName As String

OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
Workbooks.Open OpenFileName

Dim Shozoku As String
Dim Kubun As String
Dim StartYmd As String
Dim MainName As String
Dim NameFuri As String
Dim BloodType As String
Dim Add As String
Dim AddFuri As String
Dim Tel1 As String
Dim Tel2 As String

Shozoku = ActiveWorkbook.ActiveSheet.Range("B4").Value
Kubun = ActiveWorkbook.ActiveSheet.Range("F4").Value
StartYmd = ActiveWorkbook.ActiveSheet.Range("I4").Value
MainName = ActiveWorkbook.ActiveSheet.Range("C9").Value
NameFuri = ActiveWorkbook.ActiveSheet.Range("E8").Value
BloodType = ActiveWorkbook.ActiveSheet.Range("I9").Value
Add = ActiveWorkbook.ActiveSheet.Range("D12").Value
AddFuri = ActiveWorkbook.ActiveSheet.Range("E11").Value
Tel1 = ActiveWorkbook.ActiveSheet.Range("C14").Value
Tel2 = ActiveWorkbook.ActiveSheet.Range("I14").Value

ActiveWorkbook.Close

ThisWorkbook.ActiveSheet.Cells(GYOU, 1).Value = Shozoku
ThisWorkbook.ActiveSheet.Cells(GYOU, 4).Value = Kubun
ThisWorkbook.ActiveSheet.Cells(GYOU, 6).Value = StartYmd
ThisWorkbook.ActiveSheet.Cells(GYOU, 3).Value = MainName
ThisWorkbook.ActiveSheet.Cells(GYOU, 8).Value = NameFuri
ThisWorkbook.ActiveSheet.Cells(GYOU, 28).Value = BloodType
ThisWorkbook.ActiveSheet.Cells(GYOU, 13).Value = Add
ThisWorkbook.ActiveSheet.Cells(GYOU, 14).Value = AddFuri
ThisWorkbook.ActiveSheet.Cells(GYOU, 15).Value = Tel1
ThisWorkbook.ActiveSheet.Cells(GYOU, 16).Value = Tel2

End Sub

回答No.3

watabe007

>これらをスッキリさせることは可能でしょうか？？
こんな感じでは
Dim OpenFileName As String
Dim wb As Workbook, v(9), ret As Variant
Dim GYOU As Long, i As Long, j As Long
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls*")
Set wb = Workbooks.Open(OpenFileName)
For Each ret In Array("B4", "F4", "I4", "C9", "E8", "I9", "D12", "E11", "C14", "I14")
　　v(i) = wb.ActiveSheet.Range(ret).Value
　　i = i + 1
Next
wb.Close
With ThisWorkbook.ActiveSheet
　　GYOU = .Range("A" & Rows.Count).End(xlUp).Row + 1
　　For Each ret In Array(1, 4, 6, 3, 8, 28, 13, 14, 15, 16)
　　　　.Cells(GYOU, ret).Value = v(j)
　　　　j = j + 1
　　Next
End With

回答No.1

ohkinu1972

時々参考にしているページの関連個所をピックアップしました。
これらを組み合わせればできると思います。

＞１.ファイルダイアログを開いて、【顧客データひとり分.xls】というブックを選択

名前を指定してブックを開く
http://officetanaka.net/excel/vba/file/file02.htm

＞２．【顧客データひとり分.xls】に入力されているデータを、
＞【顧客データ一覧.xls】の顧客データ一覧表の末尾に、コピーして追加・上書保存

セルの操作(セル範囲の取得)
http://officetanaka.net/excel/vba/file/file02.htm

セルの操作(セルのコピー)
http://officetanaka.net/excel/vba/cell/cell09.htm

＞３.顧客データひとり分.xlsは閉じて、更新された顧客データ一覧.xlsを表示させる

ブックを閉じる
http://officetanaka.net/excel/vba/file/file03.htm

シートを開く
http://officetanaka.net/excel/vba/sheet/sheet01.htm

お礼

ありがとうございます。まだ完成してませんが、参考にさせていただきました。