Excel 워크 시트의 데이터를 열 값 기반의 여러 통합 문서로 분할

Question

이 코드는 (Splitting worksheet into multiple workbooks)이 코드를 사용하고 있으며 간단한 데이터베이스를 사용하여 3 열에서 필터링 할 때 코드가 작동하는지 궁금합니다. 그러나 데이터베이스가 있습니다. 필터로 사용할 열 (별칭 )이 35 열 또는 "AI"에 있고이 경우 코드가 작동하지 않습니다. 따라서이 코드는 필터링 된 열의 값에 따라 통합 문서를 만들지 만 데이터 자체는 필터링되지 않으므로이 경우 세 개의 동일한 파일이 만들어집니다. 어떤 제안? 사용 된 코드입니다.

Sub CreateBatchWorkbooks() 

On Error Resume Next 
Application.DisplayAlerts = False 

With ThisWorkbook.Sheets("CalcData") 'Replace the sheet name with the raw data sheet name 

Set Newsheet = ThisWorkbook.Sheets("cal") 

    If Newsheet Is Nothing Then 
      Worksheets.Add.Name = "cal" 
     Else 
      ThisWorkbook.Sheets("cal").Delete 
      Worksheets.Add.Name = "cal" 
    End If 

     FilterField = WorksheetFunction.Match("BatchNumber()", ThisWorkbook.Sheets("CalcData").Range("1:1"), 0) 

     .Columns(FilterField).Copy 

      With ThisWorkbook.Sheets("cal") 
       .Range("a1").PasteSpecial (xlPasteAll) 
       .Columns("a").RemoveDuplicates Columns:=1, Header:=xlYes 
      End With 

        For Each cell In ThisWorkbook.Sheets("cal").Columns("a").Cells 
         i = i + 1 
          If i <> 1 And cell.Value <> "" Then 
           .AutoFilterMode = False 
           .Rows(1).AutoFilter field:=FilterField, Criteria1:=cell.Value 
           Set new_book = Workbooks.Add 
           .UsedRange.Copy 
           new_book.Sheets(1).Range("a1").PasteSpecial (xlPasteAll) 
           new_book.SaveAs Filename:=ThisWorkbook.Path & "\" & cell.Value & ".xlsx" 
           new_book.Sheets(1).UsedRange.Columns.AutoFit 
           new_book.Save 
           new_book.Close 
          End If 
        Next cell 

         ThisWorkbook.Sheets("cal").Delete 
End With 

End Sub 

미리 감사드립니다.

Answer 1

답변을 찾았습니다. 나는 경우에 여기에 게시는 (Next`가 ([문서]를 참조하십시오 재개라는 이름의 테이블 또는 데이터베이스 :

Sub CreateBatchWorkbooks() 

On Error Resume Next 
Application.DisplayAlerts = False 

With ThisWorkbook.Sheets("CalcData") 'Replace the sheet name with the raw data sheet name 

Set Newsheet = ThisWorkbook.Sheets("cal") 

    If Newsheet Is Nothing Then 
      Worksheets.Add.Name = "cal" 
     Else 
      ThisWorkbook.Sheets("cal").Delete 
      Worksheets.Add.Name = "cal" 
    End If 

     FilterField = WorksheetFunction.Match("BatchNumber()", ThisWorkbook.Sheets("CalcData").Range("1:1"), 0) 

     .Columns(FilterField).Copy 

      With ThisWorkbook.Sheets("cal") 
       .Range("a1").PasteSpecial (xlPasteAll) 
       .Columns("a").RemoveDuplicates Columns:=1, Header:=xlYes 
      End With 

        Dim rngFilteredCalcData 
        For Each cell In ThisWorkbook.Sheets("cal").Columns("a").Cells 
         i = i + 1 
          If i <> 1 And cell.Value <> "" Then 
           Set rngFilteredCalcData = .ListObjects("tblCalcData").Range 
           rngFilteredCalcData.AutoFilterMode = False 
           rngFilteredCalcData.AutoFilter field:=FilterField, Criteria1:=cell.Value 

           Set new_book = Workbooks.Add 
           rngFilteredCalcData.SpecialCells(xlCellTypeVisible).Rows.Copy 
           new_book.Sheets(1).Range("a1").PasteSpecial (xlPasteAll) 
           new_book.SaveAs Filename:=ThisWorkbook.Path & "\" & cell.Value & ".xlsx" 
           new_book.Sheets(1).UsedRange.Columns.AutoFit 
           new_book.Save 
           new_book.Close 
          End If 
        Next cell 

         ThisWorkbook.Sheets("cal").Delete 
End With 

End Sub