5

さて、私は同様の質問を探しようとしましたが、ExcelのVBAエディターを見るのは初めてなので、何が議論されているのかよくわかりませんでした。

簡単に言うと、「Sheet1」と「Sheet2」の2つのスプレッドシートがあります。

シート1：

    A         B
1 Header1   Header2
2 Text1     Info1
3 Text2     Info2

シート2：

    A         B
1 Header1   Header2
2 Text3     Info3
3 Text4     Info4

そして、次のように、2つのシートを新しいシート（Sheet3）にマージするマクロが必要です。

    A         B
1 Header1   Header2
2 Text1     Info1
3 Text2     Info2
4 Text3     Info3
5 Text4     Info4

マクロを記録して、後で使用するために保存してみました。これを行うには、新しいシートを作成し、Sheet1からSheet3まですべてをコピーして貼り付けてから、Sheet2からSheet3までの見出しを除くすべての情報をコピーします。

マクロはこのデータに対して機能しますが、Excelによって生成されたコードによってマクロが作成されるため、データを貼り付ける前にセルA4（ここ）が選択されることがわかりました。これはこのデータでは機能しますが、各シートのレコード数が何度も変更されると機能しません。基本的に、

1）次のデータセット（この例ではセルA4、もう1つのテーブルがある場合はセルA6）を貼り付ける前に、最後の関連セルに自動的に移動する関数があるかどうか疑問に思いました。

2）関数「ActiveCell.SpecialCells（xlLastCell）.Select」（Ctrl + Endを使用するとアクティブになります）を見ましたが、それでシートの最後に移動します。最適に機能させるには、その機能を使用した後、「ホーム」および「下」矢印キーに似たものが必要になります。

これらのオプションのいずれかが私に適しています。^ _ ^

これが、Excel2010でマクロレコーダーから記録された現在のVBAコードです。

Sub Collate_Sheets()

    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Name = "Sheet3"
    Sheets("Sheet1").Select
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Sheets("Sheet3").Select
    ActiveSheet.Paste
    ActiveCell.SpecialCells(xlLastCell).Select
    ' I need to select one cell below, and the cell in column A at this point
    Sheets("Sheet2").Select
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    ActiveSheet.Paste
End Sub

役に立つ情報を忘れていないことを願っています。私がやったかどうか教えてください！

4

2 に答える 2

6

ジェリー、このコードを試してみてください。私はあなたのコードを少しクリーンアップし、あなたが望むことを実行できるようにすることをより効率的にしました。私はあなたのコードが正しいと思うことを言ったことに基づいていくつかの仮定をしました。そうでない場合は、この回答にコメントしてください。必要に応じて調整します。

Option Explicit

Sub Collate_Sheets()


   Sheets.Add After:=Sheets(Sheets.Count)
   Dim wks As Worksheet
   Set wks = Sheets(Sheets.Count)

   wks.Name = "Sheet3"

   With Sheets("Sheet1")

    Dim lastrow As Long
    lastrow = .Range("B" & .Rows.Count).End(xlUp).Row

    .Range("A1:B" & lastrow).Copy wks.Range("A" & wks.Rows.Count).End(xlUp)

   End With

   With Sheets("Sheet2")

    lastrow = .Range("B" & .Rows.Count).End(xlUp).Row

    .Range("A2:B" & lastrow).Copy wks.Range("A" & wks.Rows.Count).End(xlUp).Offset(1)

   End With


End Sub
于 2012-12-03T16:07:55.560 に答える
0

エラーを回避するために、作成前にShee3を削除したい場合

   'Delete Sheet 3
   Application.DisplayAlerts = False
   Sheets("Sheet3").Delete

ありがとうスコットホルツマン！

于 2016-12-06T06:08:50.730 に答える