워크 시트를 결합하고 Excel에서 열을 추가하십시오.

Question

다른 데이터 소스를 식별하는 여러 탭이있는 워크 시트가 있습니다. 모든 워크 시트를 하나로 결합한 다음 워크 시트 이름이있는 열을 새 결합 시트의 일부로 추가해야합니다.

다음 코드를 찾았습니다. 내 워크 시트에 잘라내어 붙여 넣기해도 매력적이지만,이 통합 문서가 여러 개 있습니다. 매월이 프로세스를 다시 만들 수 있어야합니다.

내 연구에 따르면이 작업을 수행하려면 com 추가 또는 불러 오기 매크로를 만들어야하지만 시도 할 때마다 프로세스가 실패합니다. somone이 Excel (2013)에서이 작업을 수행하는 단계를 알려주고 코드가 제대로 작동하는지 알려 주시면 감사하겠습니다.
미리 감사드립니다.

Sub Combine() 
    Dim J As Integer, wsNew As Worksheet 
    Dim rngCopy As Range, rngPaste As Range 
    Dim Location As String 

    On Error Resume Next 
    Set wsNew = Sheets("Combined") 
    On Error GoTo 0 
     'if sheet does not already exist, create it 
     If wsNew Is Nothing Then 
     Set wsNew = Worksheets.Add(before:=Sheets(1)) ' add a sheet in first place 
     wsNew.Name = "Combined" 
    End If 

    'copy headings and paste to new sheet starting in B1 
    With Sheets(2) 
     Range(.Range("A1"), .Cells(1, Columns.Count).End(xlToLeft)).Copy wsNew.Range("B1") 
    End With 

    ' work through sheets 
    For J = 2 To Sheets.Count ' from sheet 2 to last sheet 
     'save sheet name/location to string 
     Location = Sheets(J).Name 

     'set range to be copied 
     With Sheets(J).Range("A1").CurrentRegion 
      Set rngCopy = .Offset(1, 0).Resize(.Rows.Count - 1) 
     End With 

     'set range to paste to, beginning with column B 
     Set rngPaste = wsNew.Cells(Rows.Count, 2).End(xlUp).Offset(2, 0) 

     'copy range and paste to column *B* of combined sheet 
     rngCopy.Copy rngPaste 

     'enter the location name in column A for all copied entries 
     Range(rngPaste, rngPaste.End(xlDown)).Offset(0, -1) = Location 

    Next J 
End Sub 

Answer 1

이 코드를 개인용 매크로 통합 문서에 추가하고 수정하여 ActiveWorkbook에서 작동하도록 할 수 있습니다. 이렇게하면 실행하면 Excel에서 선택한 통합 문서에서 작동합니다.

또한 통합 문서 개체 참조로 모든 시트 참조의 적합성을 검증 할 가치가 있습니다. 사용할 때 (예 :

)

Sheets("Combined") 

ActiveWorkbook을 기본값으로 사용합니다. 일반적으로 이것은 원하는 것이지만 (예일 수도 있지만) 코드에서 다른 통합 문서를 열거 나 활성화하면 다른 통합 문서가 이제 Sheets(....) 참조의 대상이되면이 방법으로 문제가 발생할 수 있습니다. 그래서

ThisworkBook.Sheets()    'the workbook containing the running code 
ActiveWorkbook.Sheets()   'the selected workbook 
Workbooks("test.xlsx").Sheets() 'named workbook 
wb.Sheets()      'use a variable set to a workbook object 

를 기존 코드 수정 - 예를 들면 : 당신의 의견을

Sub Combine() 
    Dim wb As Workbook 
    Dim J As Integer, wsNew As Worksheet 
    Dim rngCopy As Range, rngPaste As Range 
    Dim Location As String 

    Set wb = ActiveWorkbook 

    On Error Resume Next 
    Set wsNew = wb.Sheets("Combined") 
    On Error GoTo 0 
     'if sheet does not already exist, create it 
     If wsNew Is Nothing Then 
     Set wsNew = wb.Worksheets.Add(before:=wb.Sheets(1)) ' add a sheet in first place 
     wsNew.Name = "Combined" 
    End If 

    'copy headings and paste to new sheet starting in B1 
    With wb.Sheets(2) 
     .Range(.Range("A1"), .Cells(1, Columns.Count) _ 
        .End(xlToLeft)).Copy wsNew.Range("B1") 
    End With 

    ' work through sheets 
    For J = 2 To wb.Sheets.Count ' from sheet 2 to last sheet 
     'save sheet name/location to string 
     Location = wb.Sheets(J).Name 

     'set range to be copied 
     With wb.Sheets(J).Range("A1").CurrentRegion 
      Set rngCopy = .Offset(1, 0).Resize(.Rows.Count - 1) 
     End With 

     'set range to paste to, beginning with column B 
     Set rngPaste = wsNew.Cells(Rows.Count, 2).End(xlUp).Offset(2, 0) 

     'copy range and paste to column *B* of combined sheet 
     rngCopy.Copy rngPaste 

     'enter the location name in column A for all copied entries 
     wsNew.Range(rngPaste, rngPaste.End(xlDown)).Offset(0, -1) = Location 

    Next J 

End Sub