7 개의 서로 다른 워크 시트 (동일한 통합 문서에 있음)의 데이터를 Combine [duplicate]라는 하나의 워크 시트로 복사하려고합니다.
Dec 23 2020
7 개의 다른 워크 시트 (동일한 통합 문서에 있음)의 데이터를 결합이라는 하나의 워크 시트로 복사하려고합니다. 복사하지 않으려면 '요약'이라는 시트도 필요합니다. 7 개의 워크 시트를 복사 한 후에는 삭제해야합니다.
이것은 내가 지금까지 얻은 것이지만 워크 시트 ACT 만 복사합니다.
Sub Combine()
Dim s As Worksheet, wb As Workbook, wsDest As Worksheet, rngCopy As Range
Set wb = ActiveWorkbook ' always specify a workbook
Application.DisplayAlerts = False
On Error Resume Next
wb.Sheets("ACT").Delete 'These sheets don't need to be kept or consolidated
wb.Sheets("VIC").Delete
wb.Sheets("NSW").Delete
wb.Sheets("QLD").Delete
wb.Sheets("NT").Delete
wb.Sheets("SA").Delete
wb.Sheets("WA").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'get a direct reference to the newly-added sheet
Set wsDest = wb.Worksheets.Add(before:=wb.Worksheets(1))
wsDest.Name = "Combine"
wb.Sheets(2).Range("A1").EntireRow.Copy Destination:=wsDest.Range("A1")
For Each s In ActiveWorkbook.Sheets
If s.Name <> "Summary" Then ' remove hard-coded name
Set rngCopy = s.Range("A1").CurrentRegion
'check how many rows before copying
If rngCopy.Rows.Count > 1 Then
'no need for select/activate
rngCopy.Offset(1, 0).Resize(rngCopy.Rows.Count - 1).Copy _
wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
End If
Next s
End Sub
답변
Tomasz Dec 23 2020 at 15:56
아래 코드를 시도하면 에디션이 표시됩니다.
Sub Combine()
Dim rngCopy As Range '<< edited visual
Dim wb As Workbook '<< edited visual
Dim s As Worksheet, wsDest As Worksheet '<< edited visual
Application.DisplayAlerts = False '<< edited
Application.EnableEvents = False '<< edited
Application.ScreenUpdating = False '<< edited
Set wb = ThisWorkbook '<< edited
'get a direct reference to the newly-added sheet
Set wsDest = wb.Worksheets.Add(before:=wb.Worksheets(1)) '<< edited visual
wsDest.Name = "Combine" '<< edited visual
wb.Worksheets(2).Rows(1).EntireRow.Copy Destination:=wsDest.Range("A1") '<< edited
For Each s In wb.Worksheets '<< edited
If s.Name = "ACT" Or s.Name = "VIC" Or s.Name = "NSW" Or _
s.Name = "QLD" Or s.Name = "NT" Or s.Name = "SA" Or s.Name = "WA" Then '<< edited
s.Delete '<< edited
ElseIf s.Name <> "Summary" Then '<< remove hard-coded name
Set rngCopy = s.Range("A1").CurrentRegion
'check how many rows before copying
If rngCopy.Rows.Count > 1 Then
'no need for select/activate
rngCopy.Offset(1, 0).Resize(rngCopy.Rows.Count - 1).Copy _
wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
End If
Next s
Application.DisplayAlerts = True '<< edited
Application.EnableEvents = True '<< edited
Application.ScreenUpdating = True '<< edited
End Sub