Microsoft ExcelでVBAを使用して一枚に各シートのセルのCurrentRegionをコピー
一度に複数のシートを処理していて、各シートからマスターワークシートにデータをコピーする場合は、この記事を読む必要があります。 VBAコードのcurrentregionプロパティを使用して、すべてのワークシートのデータを1つのシートに統合します。このプロパティは、AutoFormatメソッドなど、選択範囲を自動的に拡張して現在の領域全体を含める多くの操作に役立ちます。このプロパティは、保護されたワークシートでは使用できません。
条件は次のとおりです。すべてのシートに同様の形式、つまり同じ数の列が含まれている必要があります。同じ形式を使用して、データを正確にマージできます。
注意：この記事では、VBAコードの使用について説明します。何らかの理由で1つのシートの列数が異なる場合、マージされたデータ全体では正確な画像が得られません。同じ数の列を使用することを強くお勧めします。 VBAコードは、新しいシートをブックに追加し、各シートの後に上書きせずにデータをコピーして貼り付けます。
Jan、Feb、Marの3枚のシートの例を見てみましょう。これらのシートのスナップショットは次のとおりです。
すべてのシートのデータを1つのシートに結合するには、以下の手順に従ってVBエディターを起動する必要があります。
[開発者]タブをクリックし、[コード]グループから[VisualBasic]を選択します
-
以下のコードを標準モジュールにコピーします
Sub CopyCurrentRegion()
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.Range("A1").CurrentRegion.Copy DestSh.Cells(Last + 1, 1)
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Sub CopyCurrentRegionValues()
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.Range("A1").CurrentRegion
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
私たちのブログが気に入ったら、Facebookで友達と共有してください。また、TwitterやFacebookでフォローすることもできます。
_私たちはあなたからの連絡をお待ちしております。私たちの仕事を改善、補完、または革新し、あなたのためにそれをより良くする方法を教えてください。 [email protected]_までご連絡ください