이 기사에서는 통합 문서의 모든 시트에서 새 시트로 데이터를 복사하는 매크로를 만듭니다.

이 예의 원시 데이터는 서로 다른 시트에있는 서로 다른 부서의 직원 세부 정보로 구성됩니다. 직원 세부 정보를 단일 시트로 통합하려고합니다.

ArrowRawData

데이터 통합을 위해 “CopyRangeFromMultipleSheets”매크로를 만들었습니다. 이 매크로는 “데이터 통합”버튼을 클릭하여 실행할 수 있습니다.

ArrowMain

매크로는 새 워크 시트를 만들고 모든 워크 시트에서 통합 된 데이터를 삽입합니다.

ArrowOutput

코드 설명

모든 시트를 ‘루핑’하여 “마스터”시트가 있는지 확인합니다.

ThisWorkbook.Worksheets의 각 소스에 대해 Source.Name = “Master”If Source.Name = “Master”Then MsgBox “마스터 시트가 이미 있습니다.”

Exit Sub End If Next 위 코드는 통합 문서에“Master”시트가 있는지 확인하는 데 사용됩니다. 통합 문서에 “마스터”시트가 있으면 코드가 종료되고 오류 메시지가 표시됩니다.

Source.Range ( “A1”). SpecialCells (xlLastCell) .Row 위 코드는 시트에서 마지막 셀의 행 번호를 가져 오는 데 사용됩니다.

Source.Range ( “A1”, Range ( “A1”). SpecialCells (xlLastCell)). Copy Destination.Range ( “A”& DestLastRow)

위 코드는 지정된 범위를 정의 된 셀에 복사하는 데 사용됩니다.

아래 코드를 따르세요

Sub CopyRangeFromMultipleSheets()

'Declaring variables

Dim Source As Worksheet

Dim Destination As Worksheet

Dim SourceLastRow, DestLastRow As Long

Application.ScreenUpdating = False

'Looping through all sheets to check whether "Master" sheet exist

For Each Source In ThisWorkbook.Worksheets

If Source.Name = "Master" Then

MsgBox "Master sheet already exist"

Exit Sub

End If

Next

'Inserting a new sheet after the "Main" sheet

Set Destination = Worksheets.Add(after:=Sheets("Main"))

Destination.Name = "Master"

'Looping through all the sheets in the workbook

For Each Source In ThisWorkbook.Worksheets



'Preventing consolidation of data from "Main" and "Master" sheet

If Source.Name <> "Main" And Source.Name <> "Master" Then



SourceLastRow = Source.Range("A1").SpecialCells(xlLastCell).Row



Source.Activate



If Source.UsedRange.Count > 1 Then



DestLastRow = Sheets("Master").Range("A1").SpecialCells(xlLastCell).Row



If DestLastRow = 1 Then

'copying data from the source sheet to destination sheet

Source.Range("A1", Range("A1").SpecialCells(xlLastCell)).Copy Destination.Range("A" & DestLastRow)

Else

Source.Range("A2", Range("A1").SpecialCells(xlCellTypeLastCell)).Copy Destination.Range("A" & (DestLastRow + 1))

End If



End If

End If

Next

Destination.Activate

Application.ScreenUpdating = True

End Sub

이 블로그가 마음에 들면 Facebook 및 Facebook에서 친구들과 공유하십시오.

여러분의 의견을 듣고 싶습니다. 작업을 개선하고 더 나은 서비스를 제공 할 수있는 방법을 알려주십시오. [email protected]로 문의 해주세요