이것은 다른 사람들의 게시물과 조언에서 모아서 내 필요에 맞게 수정 한 현재 코드입니다.목록에서 값을 기반으로 매크로 실행
'는 코드가 현재 테이블에 값을 읽는 고유의 목록을 만들기 위해 값을 필터링
을 무엇, 그것은 목록에있는 값의 고유 목록라는 시트를 그 값을 사용하고 만듭니다. 이 목록을 기반으로 표에 나열된 고유 값에 대한 시트가 만들어집니다.
'이 코드는 위대한 지금까지 작동하지만 지금은 그 고유 값 기반으로 정보를 추가 할 필요가
문제. 아래에 나는 새로운 프로 시저 (원래 데이터 테이블의 데이터를 추가 할)를 넣고 싶은 위치에 주석 ('> 새 프로 시저를 삽입하고 싶습니다.)을 넣습니다. 아래에 제가 추가하고 싶은 절차가 있습니다. 그러나 내가 그것을 실행할 때, 그것은 그것이해야하는 것보다 더 많은 탭을 만든 다음 내 Excel을 종료합니다. 원하는 결과는이 고유 한 값을 가진 원본 테이블로 이동하여 고유 한 값을 기반으로 테이블을 필터링하고 특정 열의 모든 정보를 복사 한 다음 방금 생성 된 시트와 관련된 시트에 다시 붙여 넣기위한 것입니다 그 특정 가치를 위해 전에.
솔직히 말해서 나는 테스트 절차에서 rCell을 가지고 있으며 그 점을 좋아하지 않는다고 생각합니다. "원시 데이터"시트로 이동하여 정보를 복사하는 방법을 알고 있지만 어떻게 이전 시트로 돌아갈 지 모르겠습니다. 그 시트를 그 이름을 기반으로 불러 내고 싶지만 루프가되어 그 목록의 모든 고유 한 값에 대해 실행해야합니다.
도움을 주시면 감사하겠습니다. 나는 그 많은 것을 읽을 줄 압니다. 나는 당신에게 당신이 내 프로젝트를 이해할 수 있도록 많은 정보를주고 싶다.
'this is the code i want to insert into my 'Pagesbydescription' macro
'test start
Sheets("Raw Data").Select
Selection.AutoFilter
ActiveSheet.ListObjects("Table3").Range.AutoFilter Field:=11, Criteria1:= _
rCell
Range("A3:J5000").Select
Selection.Copy
Sheets.Select
Range("A3").Select
ActiveSheet.Paste
Columns("A:K").EntireColumn.AutoFit
'test end
Sub PagesByDescription()
'
'PagesByDescription
'
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String
Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
'Set a range variable to the correct item column
Set rRange = Range("K4", Range("K5000").End(xlUp))
'Delete any sheet called "UniqueList"
'Turn off run time errors & delete alert
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("UniqueList").Delete
'Add a sheet called "UniqueList"
Worksheets.Add().Name = "UniqueList"
'Filter the Set range so only a unique list is created
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A1"), True
'Set a range variable to the unique list, less the heading.
Set rRange = .Range("A1", .Range("A5000").End(xlUp))
End With
On Error Resume Next
With wSheetStart
For Each rCell In rRange
strText = rCell
.Range("k1").AutoFilter 1, strText
Worksheets(strText).Delete
'Add a sheet named as content of rCell
Worksheets.Add().Name = strText
'> I would like to Insert new procedure here
Next rCell
End With
With wSheetStart
.AutoFilterMode = False
.Activate
End With
On Error GoTo 0
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets("NA").Delete
Sheets("BODY").Delete
Sheets("BODY PREBUILD").Delete
Application.DisplayAlerts = True