1

75 個のタブを持つ Excel スプレッドシートがあります。各タブは、2 列の単語で同じようにフォーマットされています。このすべてのデータを 1 つのページにまとめたいのですが、各タブからプログラムでテーブルを抽出し、それを 1 つのタブに貼り付ける方法がわかりません。

これをExcelで行う方法はありますか？

さて、これが私が試したコードです：

Sub Macro5()

    Range("A1:B30").Select
    Selection.Copy
    Sheets("Table 1").Select
    Selection.End(xlDown).Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
End Sub

すべてのタブは、A1:B30 からのすべてのセルのデータを使用して、同じ方法で書式設定されます。Selection.End コマンドは、次に利用可能な開いているセルに移動し、その中に後続のタブからデータを貼り付けると考えています。

現在のところ、各タブに移動してこのマクロを個別に実行する必要がありますが、貼り付けられたデータが既存のデータと同じタイプ/形式ではないため、機能しません。

何か案は？

コーディング試行 #2 - 成功!!!

    Sub Macro5()

    Dim ws As Worksheet
        For Each ws In ActiveWorkbook.Worksheets
            ws.activate
            Range("A1:B30").Select
            Selection.Copy
            Sheets("Table 1").Select
            Selection.End(xlDown).Select
            Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
                , SkipBlanks:=False, Transpose:=False

            On Error Resume Next 'Will continue if an error results

            Next ws
End Sub

ええと、あなたが答えをスプーンで教えてくれなくてよかったと認めたくありません。よろしくお願いします。

コーディング試行 #3 - 選択を避ける

Sub Macro5()

    Dim ws As Worksheet
        For Each ws In ActiveWorkbook.Worksheets
            Set Rng = ws.Range("A1:B30")
            Rng.Copy

            Dim ws1 As Worksheet
            Set ws1 = Worksheets("Table 1")
            ws1.Select
            Selection.End(xlDown).Select
            Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
                , SkipBlanks:=False, Transpose:=False

            On Error Resume Next 'Will continue if an error results
            Next ws
End Sub

正しくありません。それでも機能しますが、最初のワークブックに到達したときに「選択」を使用しないようにする方法がわかりません。コンテンツなしで最も近いセルを参照する方法はありますか? 「End」キーでこれができることは知っていますが、非選択ベースの方法はありますか?

4

1 に答える 1

2

このコードを参照してください。

  1. あなたのコードを変更して、まったく使用しないようにし.Selectまし.Activateた。
  2. コードにコメントを付けたので、理解に問題はありません。:)
  3. コードは使用しませんOn Error Resume Next。必要でない限り、常にそれを避けるべきです。代わりに適切なエラー処理を使用してください。On Error Resume Nextアプリケーションに単にシャットダウンするように指示することを検討してください。:)

基本的なエラー処理の例を次に示します

Sub Sample()
    On Error GoTo Whoa

    '
    '~~> Rest of Code
    '

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

最終的なコードは次のようになります。.Selectまたはの使用を避けます.Activate。また、使用を回避し、コピーする必要がある正確な範囲とコピーする必要がある正確な範囲をSelection見つけます。また、適切なエラー処理も行います。

Option Explicit

Sub Sample()
    Dim wsInput As Worksheet, wsOutput As Worksheet
    Dim rng As Range
    Dim LRowO As Long, LRowI As Long

    On Error GoTo Whoa

    '~~> Set your Output Sheet
    Set wsOutput = ThisWorkbook.Sheets("Table 1")

    '~~> Loop through all sheets
    For Each wsInput In ThisWorkbook.Worksheets
        '~~> Ensure that we ignore the output sheet
        If wsInput.Name <> wsOutput.Name Then
            '~~> Working with the input sheet
            With wsInput
                '~~> Get the last row of input sheet
                LRowI = .Range("A" & .Rows.Count).End(xlUp).Row
                '~~> Set your range for copying
                Set rng = .Range("A1:B" & LRowI)
                '~~> Copy your range
                rng.Copy
                '~~> Pasting data in the output sheet
                With wsOutput
                    '~~> Get the next available row in output sheet for pasting
                    LRowO = .Range("A" & .Rows.Count).End(xlUp).Row + 1

                    '~~> Finally paste
                    .Range("A" & LRowO).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                End With
            End With
        End If
    Next wsInput

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub
于 2012-08-03T04:52:31.610 に答える