0

3 つのワークシートからサマリー シートにデータを追加するこのコードがありますが、実行時にシート 1 と 2 から 13 行のうち 12 行を取得し、シート 3 から 13 行をサマリーに送信して、これを機能させたいと考えています。別のワークブックの概要シート

Sub SummurizeSheets()
Dim ws As Worksheet

Application.ScreenUpdating = False
Sheets("Summary").Activate

For Each ws In Worksheets
    If ws.Name <> "Summary" Then
        ws.Range("D2:D6, D8:D15").Copy
        Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp).Offset(0, 0).PasteSpecial (xlPasteValues)
    End If
Next ws
End Sub
4

1 に答える 1

1

に変更Offset(0,0)しOffset(1,0)ます。何が起こっているかというと、12 行をコピーしているということではなく、後続のブロックが前のブロックの最後から貼り付けられているということです。つまり、最初のブロックは D1:D13 に貼り付けられ、2 番目のブロックは D13:D26 に貼り付けられます。を使用Offset(1,0)すると、最初の空のセル (つまりD14) から 2 番目のブロックが貼り付けられます。

コードで結果を作成し、貼り付けで参照するだけで、新しいワークブックに結果を配置できます。次に例を示します。

Option Explicit

Sub SummurizeSheets()
    Dim ws As Worksheet
    Dim currentWB As Workbook: Set currentWB = ActiveWorkbook
    Dim newWB As Workbook: Set newWB = Application.Workbooks.Add

    newWB.Worksheets(1).Name = "Summary"

    For Each ws In currentWB.Worksheets
        ws.Range("D2:D6, D8:D15").Copy
        With newWB.Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp)
            If IsEmpty(.Value) Then
                .PasteSpecial (xlPasteValues)
            Else
                .Offset(1, 0).PasteSpecial (xlPasteValues)
            End If
        End With
    Next ws
End Sub

行 1 であっても、列の最初の空のセルに貼り付けるようにEDITが更新されました。

于 2013-10-22T12:03:57.093 に答える