http://homepage1.nifty.com/h-fuji/excel_sample.htmの■簡単入力ブックについてですが

DATAシートに入力というシートから転記を行うマクロが組まれています。
もうひとつシートを増やしてそこからも転記ができるようにしたいのですが、行は増えるのですが内容が転記されません。
Sub 転記()
Application.ScreenUpdating = False
'
If Range("B4") = "" Or Range("B5") = "" Then
MsgBox "氏名コードか電話番号が未入力です。"
Range("B4").Select
End
End If

If 修正行 > 0 And 状態 = "修正" Then
GYOU = 修正行
End If

If 修正行 = 0 Or 状態 = "流用" Then
GYOU = Worksheets("DATA").Range("A4").CurrentRegion.Rows.Count + 4
End If

Sheets("入力").Select
owari_g = Range("a4").CurrentRegion.Rows.Count + 3
Range("b4:b" & owari_g).Select
Selection.Copy
Sheets("DATA").Select
Range("A" & GYOU).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Sheets("入力").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("B5").Formula = "=PHONETIC(B4)"
Range("b2").ClearContents
Range("B4").Select
End Sub

Sheets("入力").Selectの入力を新たに増やした
シート名にするだけでは足りないでしょうか?

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2007/09/14 19:58:30
  • 終了:2007/09/14 20:38:48

回答(2件)

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982007/09/14 20:20:25

ポイント100pt

新しく作ったシートを シート2と するとします。

Sub 転記()

の モジュールは コピーして Sub 転記() の次に

Sub 転記2() とします。

Sheets("入力") の箇所は すべて

Sheets("シート2") に 変更します。

登録のボタンの割り当ては 転記2にします。

これで 転記だけ できます。

ほかのボタンも使うなら 同様の修正を 行えばいいでしょう。



http://kiyopon.sakura.ne.jp/vba/index.htm#ボタンを作成して操作を自動実行する

id:mika555

ばっちりわかりました。

でも、また難問があるので自分で頑張ってから

また質問します。

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

2007/09/14 20:36:41
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912007/09/14 20:27:11

ポイント100pt

新たなシート名にすれば、そちらのシートからは入力できるようになりますが、もともとの入力シートからは入力されません。


入力をしたい方から入力するためにはシートを指定できるようにする必要があります。

入力シート名をそれぞれ、入力1、入力2とすると

まず、マクロを下記のように変更し

Sub 転記1()
    転記共通 "入力1"
End Sub

Sub 転記2()
    転記共通 "入力2"
End Sub

Sub 転記共通(sheetName As String)
'
' 転記 Macro
' マクロ記録日 : 1999/4/27  ユーザー名 : h.fujihara
'
    
    Application.ScreenUpdating = False
'
    If Range("B4") = "" Or Range("B10") = "" Then
        MsgBox "氏名か電話番号が未入力です。"
        Range("B4").Select
        End
    End If
    
    If 修正行 > 0 And 状態 = "修正" Then
        GYOU = 修正行
    End If
    
    If 修正行 = 0 Or 状態 = "流用" Then
        GYOU = Worksheets("DATA").Range("A4").CurrentRegion.Rows.Count + 4
    End If
        
    Sheets(sheetName).Select
    owari_g = Range("a4").CurrentRegion.Rows.Count + 3
    Range("b4:b" & owari_g).Select
    Selection.Copy
    Sheets("DATA").Select
    Range("A" & GYOU).Select
    Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
    Sheets(sheetName).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B5").Formula = "=PHONETIC(B4)"
    Range("b2").ClearContents
    Range("B4").Select
End Sub

次にそれぞれのシートにある登録ボタンを下記のように変更します。

汎用簡単入力集計.xls!転記1

汎用簡単入力集計.xls!転記2

その他のボタンに関しても同様の処理をする必要があります。


EXCEL でお仕事 シートやブックを越えたRangeオブジェクト取得

id:mika555

丁寧にありがとうございます。

戻りも条件によってそれぞれのシートにしたいので

自分でとりあえず頑張ってみます。

また、よろしくお願いします。

2007/09/14 20:38:08
  • id:Mook
    それぞれのシートによって、入力形式や処理が異なるのであれば taknt さんの方法が良いかもしれません。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません