エクセルの質問です。

下記のように、ユーザーがInputBoxを使って必要なところだけ転記するスクリプトを書いたのですが、これを拡張したいと思っております。
シートに同じフォーマットがずらっと並んでいる時に、その該当部分すべてを別シートに転記するにはどうしたらよいでしょうか。
よろしくお願いいたします。

Dim tenki As Range
Set tenki = Application.InputBox( _
Prompt:="セル範囲を選択", _
Title:="セル選択", _
Type:=8)

tenki.Copy Destination:=Sheets("Sheet3").Range("A1")

回答の条件
  • URL必須
  • 1人5回まで
  • 登録:2008/06/04 18:06:13
  • 終了:2008/06/09 01:34:42

回答(4件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692008/06/04 19:35:02

ポイント23pt

転記するセルを、ctrlを押しながら複数選択してください。

その部分が指定したシート(この場合はSheet3にコピーします)

inputbox をtypoe=8で使うときはキャンセルを押すとエラーを出すのでトラップしています。

Sub Macro()
    Dim tenki As Range
    Dim ws As Worksheet
    Dim r As Range
    
    '転記先のシートを指定
    Set ws = Worksheets("Sheet3")
    
    'キャンセルを選んだときのためエラートラップ
    On Error GoTo ErrNot
    Set tenki = Application.InputBox(prompt:="セル範囲を選択", Title:="セルを選択", Type:=8)
    On Error GoTo 0
    
    For Each r In tenki
        r.Copy Destination:=ws.Range(r.Address)
    Next
    
    Exit Sub
ErrNot:
End Sub

http://q.hatena.ne.jp/

id:clinejp

ありがとうございます。

書式そのものをコピーするにはどうしたらいいか教えていただけたら幸いです。

2008/06/05 00:13:11
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692008/06/05 00:56:06

ポイント23pt

セルを書式を含め全てをコピーする方法です。

他にもPasteSpecialの引数を変えることで、書式だけとか、数式とかコピーすることができます。

http://634.ayumu-baby.com/vba/vba_menu.html

Sub Macro()
    Dim tenki As Range
    Dim ws As Worksheet
    Dim r As Range
    
    '転記先のシートを指定
    Set ws = Worksheets("Sheet3")
    
    'キャンセルを選んだときのためエラートラップ
    On Error GoTo ErrNot
    Set tenki = Application.InputBox(prompt:="セル範囲を選択", Title:="セルを選択", Type:=8)
    On Error GoTo 0
    
    For Each r In tenki
        r.Copy
        ws.Range(r.Address).PasteSpecial Paste:=xlAll, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next
    
    Application.CutCopyMode = False
    
    Exit Sub
ErrNot:
End Sub
id:clinejp

大変ありがとうございます。

もうひとつお願いできますでしょうか。

私の質問文が分かりにくかったのですが、複数のシートを結合したいので、現状ですと別シートのデータをを拾った時に上書きされてしまうと思います。

行方向に、選択したデータを次々に順番に転記するということはできますでしょうか。

2008/06/05 14:49:19
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692008/06/05 18:36:41

ポイント22pt

2パターン作ってみました。お好きなほうをどうぞ。


列位置を保持してコピーしています。

ただし、2行以上を選択しないでください。複数行を選択するとおかしな動作になります。

Sub Macro1()
    Dim tenki As Range
    Dim ws As Worksheet
    Dim r As Range
    Dim w As Worksheet
    Dim myRow As Long
    
    '転記先のシートを指定
    Set ws = Worksheets("Sheet3")
    
    'キャンセルを選んだときのためエラートラップ
    On Error GoTo ErrNot
    Set tenki = Application.InputBox(prompt:="セル範囲を選択", Title:="セルを選択", Type:=8)
    On Error GoTo 0
    
    ws.Cells.Clear
    myRow = 1
    For Each w In Worksheets
        If w.Name <> ws.Name Then
            For Each r In tenki
                w.Range(r.Address).Copy
                ws.Cells(myRow, r.Column).PasteSpecial Paste:=xlAll, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Next
            myRow = myRow + 1
        End If
    Next w
        
    Application.CutCopyMode = False
    
    Exit Sub
ErrNot:
End Sub

左詰でコピーします。

複数行選択可能です。複数範囲を選択した場合はエラーになることがあります。

Sub Macro2()
    Dim tenki As Range
    Dim ws As Worksheet
    Dim r As Range
    Dim w As Worksheet
    Dim myRow As Long
    
    '転記先のシートを指定
    Set ws = Worksheets("Sheet3")
    
    'キャンセルを選んだときのためエラートラップ
    On Error GoTo ErrNot
    Set tenki = Application.InputBox(prompt:="セル範囲を選択", Title:="セルを選択", Type:=8)
    On Error GoTo 0
    
    ws.Cells.Clear
    myRow = 1
    For Each w In Worksheets
        If w.Name <> ws.Name Then
            w.Range(tenki.Address).Copy
            ws.Cells(myRow, 1).PasteSpecial Paste:=xlAll, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            myRow = myRow + tenki.Rows.Count
        End If
    Next w
        
    Application.CutCopyMode = False
    
    Exit Sub
ErrNot:
End Sub

http://q.hatena.ne.jp/

id:clinejp

ありがとうございます。

やりたかったイメージどおりです。

すみません、何度も。

当方エクセルのバージョンが2002なのですが、転記の際に書式のコピーが行われません。

これはバージョンの問題でしょうか。

2008/06/06 01:09:58
id:SALINGER No.4

SALINGER回答回数3454ベストアンサー獲得回数9692008/06/07 13:29:58

ポイント22pt

3の回答の上のほうの列幅と行の高さ版です。

Sub Macro1()
    Dim tenki As Range
    Dim ws As Worksheet
    Dim r As Range
    Dim w As Worksheet
    Dim myRow As Long
    
    '転記先のシートを指定
    Set ws = Worksheets("Sheet3")
    
    'キャンセルを選んだときのためエラートラップ
    On Error GoTo ErrNot
    Set tenki = Application.InputBox(prompt:="セル範囲を選択", Title:="セルを選択", Type:=8)
    On Error GoTo 0
    
    ws.Cells.Clear
    myRow = 1
    For Each w In Worksheets
        If w.Name <> ws.Name Then
            For Each r In tenki
                w.Range(r.Address).Copy
                ws.Cells(myRow, r.Column).PasteSpecial Paste:=xlAll, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                ws.Cells(myRow, r.Column).ColumnWidth = w.Range(r.Address).ColumnWidth
                ws.Cells(myRow, r.Column).RowHeight = w.Range(r.Address).RowHeight
            Next
            myRow = myRow + 1
        End If
    Next w
        
    Application.CutCopyMode = False
    
    Exit Sub
ErrNot:
End Sub

余談ですが、2の回答のリンク先にある列幅をコピーする方法は

xlColumnWidthsではなくxlPasteColumnWidthsの間違いですね。

http://q.hatena.ne.jp/

id:clinejp

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

また今度もよろしくお願いいたします。

2008/06/09 01:34:26
  • id:SALINGER
    どうやら複数のシートを1つにまとめる作業のようですね。
    >行方向に、選択したデータを次々に順番に転記するということはできますでしょうか。
    これだけではちょっとイメージができませんでした。
    例えば、選択したセルをシート3のA列に縦に並べてコピーするということでしょうか?
    範囲を選択した場合はどういうコピーの仕方となりますか?
  • id:clinejp
    SALINGERさんに教えていただいたctrlボタンを押しながらというのはまさにイメージどおりなのですが、最終的には下記のことがやりたいです。

    シート1
    aaa bbb ccc
    ddd eee fff
    シート2
    ggg hhh iii
    jjj kkk lll

    このシート1の1行目の3つのセルを選択すると、自動的にシート2の1行目のセルが下記のように新しいシートに並ぶようにしたいのです。

    【結果】
    シート3

    aaa bbb ccc(←ユーザが選択)
    ggg hhh iii(←自動的に抽出)
    ・・・(以下シートの数だけ同じように抽出される)

    2行目を選択した場合

    ddd eee fff(←ユーザが選択)
    jjj kkk lll(←自動的に抽出)
    ・・・(以下シートの数だけ同じように抽出される)



    質問の回答数を2ではなく上げましたので、質問欄に書き込んでいただいて結構です。

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

  • id:SALINGER
    書式は列幅と行の高さ以外は普通にコピーできると思います。
    やってることは、形式を選択して貼り付けをマクロで記録したことと同じことなので
    2002でもできると思うのですが。
  • id:clinejp
    またもや言葉足らずというか、すみません。
    書式といってしまいましたが、その列幅と行の高さも含めて転記したく思っております。

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

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

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

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