出力シートにソースシート名を含める

Question

複数のシートを1つのシートに統合し、最後の「結合済み」シートに新しい列を追加しようとしています。新しいシートには、「ソース」という名前の列があり、シート名の後ろにある行がコピーされます。あなたの助けの人たちのために事前に

Sub Final() 
Path = " " 
Filename = Dir(Path & "*.csv") 

Do While Filename <> "" 
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 
    For Each Sheet In ActiveWorkbook.Sheets 
    Sheet.Copy After:=ThisWorkbook.Sheets(1) 
    Next Sheet 
    Workbooks(Filename).Close 
    Filename = Dir() 
Loop 

Dim J As Integer 
On Error Resume Next 
Sheets(1).Select 
Worksheets.Add 
Sheets(1).Name = "Combined" 
Sheets(2).Activate 
Range("A1").EntireRow.Select 
Selection.Copy Destination:=Sheets(1).Range("A1") 

For J = 2 To Sheets.Count 
    Sheets(J).Activate 
    Range("A1").Select 
    Selection.CurrentRegion.Select 
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select 
    Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) 
Next 
End Sub 

感謝:)

Answer 1

次のコードは、（データと同等の最初の空行は列Aに存在する）は、列BにFor J = 2 To ThisWorkbook.Sheets.Countループ内のシートの名前をコピーします。ノーSelect、SelectionとActiveWorkbookあり

、代わりにWorkbooks、WorksheetsとRangeのような完全修飾オブジェクトがあります。

また、On Error Resume Nextを使用する場合は、エラーの原因とその処理方法も確認してください。あなたのケースでは、 "Combined"という名前の新しく作成されたシートの名前を変更しようとしているときに、この名前のワークブックに既にワークシートがあります。その結果、コードはこの行をスキップし、ワークシートの名前はExcelで指定されたデフォルトの名前（「シート」と最初に使用可能なインデックス番号）のままです。

コード

Option Explicit 

Sub Final() 

Dim wb As Workbook 
Dim Sheet As Worksheet 
Dim Path As String, FileName As String 
Dim J As Long 

Path = " " 
FileName = Dir(Path & "*.csv") 

Do While FileName <> "" 
    Set wb = Workbooks.Open(FileName:=Path & FileName, ReadOnly:=True) 
    For Each Sheet In wb.Sheets 
     Sheet.Copy after:=ThisWorkbook.Sheets(1) 
    Next Sheet 
    wb.Close 
    Set wb = Nothing 
    FileName = Dir() 
Loop 

On Error Resume Next 
Set Sheet = Worksheets.Add(after:=Sheets(1)) 
Sheet.Name = "Combined" 
If Err.Number <> 0 Then 
    Sheet.Name = InputBox("Combined already exists in workbook, select a different name", "Select new created sheet's name") 
End If 
On Error GoTo 0 

Sheets(2).range("A1").EntireRow.Copy Sheets(1).range("A1") 

For J = 2 To ThisWorkbook.Sheets.Count 
    With Sheets(J) 
     .Range("A1").CurrentRegion.Offset(1, 0).Resize(.Range("A1").CurrentRegion.Rows.Count - 1, .Range("A1").CurrentRegion.Columns.Count).Copy _ 
     Destination:=Sheets(1).Range("A65536").End(xlUp) 
     Sheets(1).Range("B" & Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row).Value = .Name '<-- copy the sheet's name to column B 
    End With 
Next J  

End Sub 

Answer 2

これは新しいシートを作成したり、既存のものをきれいにし、2列を追加します：ソースファイルの

• ソースシートの一つ
• 一つを

試してみてください：

Sub Test_Matt() 
Dim BasePath As String 
Dim FileName As String 
Dim tB As Workbook 
Dim wB As Workbook 
Dim wS As Worksheet 
Dim wSCopied As Worksheet 
Dim LastRow As Double 
Dim ColSrcShtCombi As Integer 
Dim ColSrcWbCombi As Integer 
Dim wSCombi As Worksheet 
Dim NextRowCombi As Double 
Dim J As Integer 

Set tB = ThisWorkbook 
On Error Resume Next 
    Set wSCombi = tB.Sheets("Combined") 
    If wSCombi Is Nothing Then 
     Set wSCombi = tB.Sheets.Add 
     wSCombi.Name = "Combined" 
    Else 
     wSCombi.Cells.Clear 
    End If 
On Error GoTo 0 

With wSCombi 
    '''I don't know which sheet that is your take your headers from, 
    '''but here is where to define it: 
    tB.Sheets(2).Range("A1").EntireRow.Copy Destination:=wSCombi.Range("A1") 
    '''Add "Source"s columns 
    ColSrcShtCombi = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1 
    .Cells(1, ColSrcShtCombi).Value = "Source Sheet" 
    ColSrcWbCombi = ColSrcShtCombi + 1 
    .Cells(1, ColSrcWbCombi).Value = "Source Workbook" 
End With 

'''Define here the folder you want to scan: 
BasePath = "C:\Example\" 
FileName = Dir(BasePath & "*.csv") 

Do While FileName <> vbNullString 
    Set wB = Workbooks.Open(FileName:=BasePath & FileName, ReadOnly:=True) 
    For Each wS In wS.Sheets 
     Set wSCopied = wS.Copy(After:=tB.Sheets(tB.Sheets.Count)) 
     '''Find next available row in Combined sheet 
     NextRowCombi = wSCombi.Range("A" & wSCombi.Rows.Count).End(xlUp).Row + 1 
     With wSCopied 
      '''Find the last row of data in that sheet 
      LastRow = .Range("A" & .Rows.Count).End(xlUp).Row 
      '''Copy the data in Combined sheet 
      .Range("A2", .Cells(LastRow, .Cells(1, .Columns.Count).End(xlToLeft).Column)).Copy _ 
       Destination:=wSCombi.Range("A" & NextRowCombi) 
      '''Put sheet's name and workbook's name in source columns 
      wSCombi.Range(wSCombi.Cells(NextRowCombi, ColSrcShtCombi), wSCombi.Cells(NextRowCombi + LastRow - 1, ColSrcShtCombi)).Value = wS.Name 
      wSCombi.Range(wSCombi.Cells(NextRowCombi, ColSrcWbCombi), wSCombi.Cells(NextRowCombi + LastRow - 1, ColSrcWbCombi)).Value = wB.Name 
     End With 'wSCopied 
    Next wS 
    wB.Close 
    FileName = Dir() 
Loop 

End Sub