エクセルVBAに関する質問です。 添付したデータベースから 転記したいデータのID番号を選択 転記ボタンをおす。

エクセルVBAに関する質問です。 添付したデータベースから 転記したいデータのID番号を選択 転記ボタンをおす。 転記先のシートの原義をコピー コピーした転記シートのシート名をデータの氏名に変更 データを転記 転記したいデータベースはID、氏名、フリガナ等の22項目 このような動作をするマクロを組もうと思うのですが、さっぱりわかりません。 マクロの記録を組み合わせてやってきたんですが限界です。参考になるサイトの紹介でも構いません。どなたかアドバイスお願いします。

画像

データベース13閲覧xmlns="http://www.w3.org/2000/svg">250

ベストアンサー

0

これでどうでしょうか。(画像が見えないので)以下はシート(「DB」「原義」)があり、DBは5行目に項目、6行目以降データとしています。また、原義の書式はDBと同じ設定にしました。処理は、DBシートのID(A列)を選択した後、実行すると、その氏名(B列)のシートが追加され、そこに選択した行のデータが転記されます。なお、追加しようとしたシートが既にある場合は既シートを使います。また、空白セルを選択して実行すると停止します。ボタンに登録してお使いください。 Sub test() Dim r, c, sr As Long Dim dname As String Dim ws1, ws2 As Worksheet Dim mydata Dim sh As Worksheet Dim flag As Boolean '氏名、データ取得 Set ws1 = Worksheets("DB") ws1.Activate r = ActiveCell.Row c = ActiveCell.End(xlToRight).Column dname = ActiveCell.Offset(, 1).Value mydata = WorksheetFunction.Transpose(Range(Cells(r, 1), Cells(r, c))) 'シート重複確認 For Each sh In Worksheets If sh.Name = dname Then flag = True Next sh '重複結果を得てシート追加 If dname <> "" Then If flag = True Then Worksheets(dname).Select Else Worksheets("原紙").Copy After:=Worksheets(Worksheets.Count) ActiveSheet.Name = dname End If Else MsgBox "空白を指定しました" Exit Sub End If '転記 Set ws2 = Worksheets(dname) ws2.Activate sr = ws2.Range("A" & Rows.Count).End(xlUp).Row ws2.Range(Cells(sr + 1, 1), Cells(sr + 1, c)) = WorksheetFunction.Transpose(mydata) End Sub

ThanksImg質問者からのお礼コメント

ありがとうございました。

お礼日時:7/31 21:13