• マクロは、Masterという名前のシートをブックに追加し、このワークシートのブック内のすべてのシートからセルをコピーします。

  • 最初のマクロは通常のコピーを実行し、2番目のマクロは値をコピーします。

  • マクロのサブは以下の関数を使用します。マクロは関数なしでは機能しません。

このsh.Rows( “1:4″)。Copyを使用して、複数の行をコピーします。

Sub Test4()

Dim sh As Worksheet

Dim DestSh As Worksheet

Dim Last As Long

If SheetExists("Master") = True Then

MsgBox "The sheet Master already exist"

Exit Sub

End If

Application.ScreenUpdating = False

Set DestSh = Worksheets.Add

DestSh.Name = "Master"

For Each sh In ThisWorkbook.Worksheets

If sh.Name <> DestSh.Name Then

If sh.UsedRange.Count > 1 Then

Last = LastRow(DestSh)

sh.Rows("1").Copy DestSh.Cells(Last + 1, 1)

End If

End If

Next

Application.ScreenUpdating = True

End Sub

Sub Test4_Values()

Dim sh As Worksheet

Dim DestSh As Worksheet

Dim Last As Long

If SheetExists("Master") = True Then

MsgBox "The sheet Master already exist"

Exit Sub

End If

Application.ScreenUpdating = False

Set DestSh = Worksheets.Add

DestSh.Name = "Master"

For Each sh In ThisWorkbook.Worksheets

If sh.Name <> DestSh.Name Then

If sh.UsedRange.Count > 1 Then

Last = LastRow(DestSh)

With sh.Rows("1")

DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _

.Columns.Count).Value = .Value

End With

End If

End If

Next

Application.ScreenUpdating = True

End Sub

Function LastRow(sh As Worksheet)

On Error Resume Next

LastRow = sh.Cells.Find(What:="*", _

After:=sh.Range("A1"), _

Lookat:=xlPart, _

LookIn:=xlFormulas, _

SearchOrder:=xlByRows, _

SearchDirection:=xlPrevious, _

MatchCase:=False).Row

On Error GoTo 0

End Function

Function Lastcol(sh As Worksheet)

On Error Resume Next

Lastcol = sh.Cells.Find(What:="*", _

After:=sh.Range("A1"), _

Lookat:=xlPart, _

LookIn:=xlFormulas, _

SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious, _

MatchCase:=False).Column

On Error GoTo 0

End Function

Function SheetExists(SName As String, _

Optional ByVal WB As Workbook) As Boolean

On Error Resume Next

If WB Is Nothing Then Set WB = ThisWorkbook

SheetExists = CBool(Len(Sheets(SName).Name))

End Function