>

이 온라인에서 다양한 솔루션을 찾았지만 원하는 솔루션을 준수 할 수 없었습니다. 문제는 다음과 같습니다.

<올>
  • 선택한 폴더완료

  • 에서 모든 .xlsx 파일 열기
  • 마스터 통합 문서를 보관 폴더로 복사 (선택한 폴더 경로/아카이브)완료

  • 2 행 이하의 "FY19 Source"(워크 시트 3)라는 워크 시트의 마스터 워크 북에서 데이터를 삭제하십시오.완료

  • 행 2 이하의 "여행 일정표"(워크 시트 4)에서 워크 시트 마스터 워크 북의 데이터를 삭제하십시오.완료

  • 5 행 이하의 "전송"(워크 시트 5)이라는 워크 시트의 마스터 워크 북에서 데이터를 삭제하십시오.완료

  • 열려있는 각 통합 문서 (마스터 통합 문서 제외)에 대해 "FY19 Source"라는 제목의 워크 시트에서 A2 : M2의 남쪽에있는 모든 행의 숨겨지지 않은 데이터 또는 null이 아닌 데이터를 복사하십시오

  • 행 2부터 시작하는 마스터 통합 문서의 "FY19 소스"워크 시트에 데이터를 지속적으로 붙여 넣기

  • 열려있는 각 통합 문서에 대해 "전송"또는 "전송 2"또는 "전송 3"이라는 워크 시트가있는 경우 각 숨겨진 A2 : M2의 모든 행에서 숨겨지지 않은/널이 아닌 데이터를 복사하십시오. .

  • 2 행부터 마스터 워크 북 "전송"워크 시트에 데이터를 연속적으로 붙여 넣기

  • 열려있는 각 통합 문서에 대해 "여행 일정"이라는 제목의 워크 시트에서 필터를 삭제하십시오

  • 열려있는 각 통합 문서 (마스터 통합 문서 제외)에 대해 A5 : L5 남쪽의 모든 행에서 숨겨 지거나 널이 아닌 데이터를 복사하십시오

  • 행 5에서 시작하는 마스터 통합 문서 "여행 일정 캘린더"워크 시트에 데이터를 지속적으로 붙여 넣기

  • 마스터 통합 문서에서 새로 고침 링크 실행완료

  • 위와 같이 열린 통합 문서에서 복사/복합 기능에 대한 도움말을 실제로 사용할 수 있습니다.

    연구 중에 비슷한 생각을 가진 몇 가지 질문을 찾았지만 실제로 답답할 수없는 것 같습니다. (이 단계 대부분을 차례로 수행 할 수있는 것처럼 보이지만 도움이 될만한 모든 것을 함께 모아주십시오. 모든 안내에 감사드립니다!

    지금까지 주석이 달린 코드 :

    Sub MasterWorkbookCompile()
    'Declaring Variables
    Dim myPath As String
    Dim archivePath As String
    Dim endSourceSheet As Worksheet
    Dim endTransferSheet As Worksheet
    Dim endTravelSheet As Worksheet
    fName = Dir(Application.ThisWorkbook.FullName)
    myPath = Application.ThisWorkbook.FullName
    archivePath = "C:\Users\XX\" & (fName)
    'Debug.Print myPath, archivePath
    'Saving current file to archive folder
    ThisWorkbook.SaveCopyAs Filename:=archivePath
    'Unfilters data on last worksheet
    On Error Resume Next
    ThisWorkbook.Worksheets("Travel-Events Calendar").ListObjects("Table2").AutoFilter.ShowAllData
    'Clearing data in relevant worksheets
    ThisWorkbook.Sheets("XXFY19 Source").Range(ThisWorkbook.Sheets("XXFY19 Source").Range("A2:M2"), ThisWorkbook.Sheets("XXFY19 Source").Range("A2:M2").End(xlDown)).ClearContents
    ThisWorkbook.Sheets("Transfer Funds").Range(ThisWorkbook.Sheets("Transfer Funds").Range("A2:M2"), ThisWorkbook.Sheets("Transfer Funds").Range("A2:M2").End(xlDown)).ClearContents
    With ThisWorkbook.Sheets("Travel-Events Calendar").ListObjects("Table2")
       .Range.AutoFilter
       .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.ClearContents
       .DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
    End With
    On Error GoTo 0
    'Opens all .xlsx files
        Dim xStrPath As String
        Dim xFileDialog As FileDialog
        Dim xFile As String
        On Error Resume Next
        Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
        xFileDialog.AllowMultiSelect = False
        xFileDialog.Title = "Select a folder"
        xFileDialog.InitialFileName = "C:\Users\XX"
        If xFileDialog.Show = -1 Then
            xStrPath = xFileDialog.SelectedItems(1)
        End If
        If xStrPath = "" Then Exit Sub
        xFile = Dir(xStrPath & "\*.xlsx")
        Do While xFile <> ""
            If Not ActiveWorkbook Then
                Workbooks.Open xStrPath & "\" & xFile
                xFile = Dir
            End If
        Loop
    
    'Refreshes any PivotTable Links
    ThisWorkbook.RefreshAll
    End Sub
    
    

    데이터 처리

                   Dim wsCopy_F19 As Long
                    Dim wsCopy_Transfer As Long
                    Dim wsCopy_Travel As Long
                    Dim wsCopy As Worksheet
                    Dim numWs As Double
                    Dim i As Double
                    Dim wsCopyName As String
                    Dim Target1 As Range
                    Dim Target2 As Range
                    Dim Target3 As Range
                    numWs = wbCopy.Worksheets.Count
                    For i = 0 To numWs
                        wsCopy = wbCopy.Worksheets(i)
                        wsCopyName = wsCopy.Name
                        If wsCopyName = "FY19 Source" Then
                            wsCopy_F19 = wsCopy.Cells(Rows.Count, 1).End(xlUp).Row
                            Set Target1 = wsCopy.Range("A2:M" & wsCopy_F19)
                            Target1.Copy Destination:=wsMSTR_XXF19.Range("A" & rowMSTR_F19).PasteSpecial(xlPasteValues)
                            rowMSTR_F19 = wsMSTR_XXF19.Cells(Rows.Count, 1).End(xlUp).Row + 1
                        ElseIf InStr(wsCopyName, "Transfer") > 0 Then
                            wsCopy_Transfer = wsCopy.Cells(Rows.Count, 1).End(xlUp).Row
                            Set Target2 = wsCopy.Range("A2:M" & wsCopy_Transfer)
                            Target2.Copy Destination:=wsMSTR_Transfer.Range("A" & rowMSTR_Transfer).PasteSpecial(xlPasteValues)
                            rowMSTR_Transfer = wsMSTR_Transfer.Cells(Rows.Count, 1).End(xlUp).Row + 1
                        ElseIf wsCopyName = "Travel-Events Calendar" Then
                            wsCopy_Travel = wsCopy.Cells(Rows.Count, 1).End(xlUp).Row
                            Set Target3 = wsCopy.Range("A2:M" & wsCopy_Travel)
                            Target3.Copy Destination:=wsMSTR_Travel.Range("A" & rowMSTR_Travel).PasteSpecial(xlPasteValues)
                            rowMSTR_Travel = wsMSTR_Travel.Cells(Rows.Count, 1).End(xlUp).Row + 1
                        Else
                        End If
                Next
    
    

    • 답변 # 1

      아래에 솔루션을 게시하십시오. 객체 변수 wsCopy = wbCopy.Worksheets(i) 를 설정하지 않아서 발생한 문제 . 그것은 Set wsCopy = wbCopy.Worksheets(i) 이어야했다 .

      마스터 서브 및 글로벌 선언은 다음과 같습니다

      Option Explicit
      'These are Global to this MODULE, no need to pass to Subs
      Dim wbMSTR As Workbook
      Dim wsMSTR_XXF19 As Worksheet
      Dim wsMSTR_Transfer As Worksheet
      Dim wsMSTR_Travel As Worksheet
      'You will increment the rows in your procedure
      Dim rowMSTR_F19 As Long
      Dim rowMSTR_Transfer As Long
      Dim rowMSTR_Travel As Long
      Sub MasterWorkbookCompile()
      'Declaring Variables
      Dim myPath As String
      Dim archivePath As String
      Dim fName As String
      Dim wbCopy As Workbook
      'Initialize
      Set wbMSTR = ThisWorkbook
      Set wsMSTR_XXF19 = wbMSTR.Worksheets("XX FY19 Source")
      Set wsMSTR_Transfer = wbMSTR.Worksheets("Transfer Funds")
      Set wsMSTR_Travel = wbMSTR.Worksheets("Travel-Events Calendar")
      fName = Dir(Application.ThisWorkbook.FullName)
      myPath = Application.ThisWorkbook.FullName
      archivePath = "C:\XXXX\" & (fName) 'Change to folder for archive subfolder
      'Set your Master data rows HERE
      rowMSTR_F19 = 2
      rowMSTR_Transfer = 2
      rowMSTR_Travel = 5
      'Debug.Print myPath, archivePath
      '****** TURNED THIS OFF FOR TESTING *******
      'Saving current file to archive folder
      ThisWorkbook.SaveCopyAs Filename:=archivePath
      'Unfilters data on last worksheet
      On Error Resume Next
      wsMSTR_Travel.ListObjects("Table2").AutoFilter.ShowAllData
      'Clearing data in relevant worksheets
      wsMSTR_XXF19.Range(wsMSTR_XXF19.Range("A2:M2"), wsMSTR_XXF19.Range("A2:M2").End(xlDown)).ClearContents
      wsMSTR_Transfer.Range(wsMSTR_Transfer.Range("A2:M2"), wsMSTR_Transfer.Range("A2:M2").End(xlDown)).ClearContents
      With wsMSTR_Travel.ListObjects("Table2")
         .Range.AutoFilter
         .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.ClearContents
         .DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
      End With
      On Error GoTo 0
      'Opens all .xlsx files
          Dim xStrPath As String
          Dim xFileDialog As FileDialog
          Dim xFile As String
          Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
          With xFileDialog
              .AllowMultiSelect = False
              .Title = "Select a folder"
              .InitialFileName = "C:\Users\XXX" 'to be set to initial folder selection path
              If .Show <> -1 Then GoTo NextCode
              xStrPath = .SelectedItems(1) & "\"
          End With
      'Handle Cancel
      NextCode:
              xStrPath = xStrPath
              If xStrPath = "" Then GoTo LeaveCode
              xFile = Dir(xStrPath & "*.xls*")
      'Make work fast, shut off some items, no screen flicker, kill clipboard alert
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual
        Application.DisplayAlerts = False
      'Disables all macros in newly opened files
        Application.AutomationSecurity = msoAutomationSecurityForceDisable
          Do While xFile <> ""
              'Set up your event code here, get the Workbook
              Set wbCopy = Workbooks.Open(Filename:=xStrPath & xFile, UpdateLinks:=0)
              'Ensure Workbook has opened before moving on to next line of code
              DoEvents
              '***********************************
              ' PERFORM ACTIONS ON THIS COPYBOOK SHEETS HERE
              '***********************************
              Call processData(wbCopy)
              'Save and Close the COPY Workbook
              wbCopy.Close SaveChanges:=False
              'Ensure Workbook has closed before moving on to next line of code
              DoEvents
      
            'Get Next File to Process
             xFile = Dir
          Loop
          'Delete empty rows in Travel Sheet
          Call DeleteEmptyRows(wbCopy)
          'Message Box when tasks are completed
          MsgBox "Master Update Complete"
      LeaveCode:
      'Turn things back on
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.DisplayAlerts = True
      'Refreshes all PivotTable and PivotGraph Links
      wbMSTR.RefreshAll
      End Sub
      
      

      데이터 처리 서브 시스템은 다음과 같습니다.

      'Handle your data transfer here, it will be cleaner
      'the same workbook variable name is used here in the args
      'it doesn't have to be named the same, it is a pointer to the actual object ByRef
      Public Sub processData(ByRef wbCopy As Workbook)
      '***** GLOBAL TO MODULE *****
      'These are Global to this MODULE, no need to pass to Subs
      'Dim wbMSTR As Workbook
      'Dim wsMSTR_XXF19 As Worksheet
      'Dim wsMSTR_Transfer As Worksheet
      'Dim wsMSTR_Travel As Worksheet
      'You will increment the rows
      'Dim rowMSTR_F19 As Long
      'Dim rowMSTR_Transfer As Long
      'Dim rowMSTR_Travel As Long
      '***** GLOBAL TO MODULE *****
      'Defining our variables as the relevant Worksheet locations we want to copy
      Dim wsCopy_F19 As Long
      Dim wsCopy_Transfer As Long
      Dim wsCopy_Travel As Long
      Dim wsCopy_XXX2 As Long
      Dim wsCopy_XXX1 As Long
      'This is the Worksheet we will target and its name
      Dim wsCopy As Worksheet
      Dim wsCopyName As String
      'Variables related to looping through Worksheets in Workbook
      Dim numWs As Double
      Dim i As Double
      'Target copy range
      Dim Target1 As Range
      Dim Target2 As Range
      Dim Target3 As Range
      Dim Target4 As Range
      Dim Target5 As Range
      
      'Gets the number of Worksheets in the Workbook
      numWs = wbCopy.Worksheets.Count
      'For worksheets 1 to the final number... do the below
      For i = 1 To numWs
       With wbCopy
          Set wsCopy = wbCopy.Worksheets(i)
          wsCopyName = wsCopy.Name
          If wsCopyName = "A 19 Source" Or wsCopyName = "B 19 Source" Or wsCopyName = "C FY19 Source" Or wsCopyName = "D FY19 Source" Or wsCopyName = "E FY19 Source" Or wsCopyName = "F 19 Source" Or wsCopyName = "G FY19 Source" Or wsCopyName = "H FY19 Source" Then
              wsCopy_F19 = wsCopy.Cells(Rows.Count, 1).End(xlUp).Row
              Set Target1 = wsCopy.Range("A2:M" & wsCopy_F19)
              Target1.Copy
              wsMSTR_XXF19.Range("A" & rowMSTR_F19).PasteSpecial Paste:=xlValues
              rowMSTR_F19 = wsMSTR_XXF19.Cells(Rows.Count, 1).End(xlUp).Row + 1
          ElseIf wsCopyName = "XXX3 FY19 Source" Then
              wsCopy_Transfer = wsCopy.Cells(Rows.Count, 1).End(xlUp).Row
              Set Target2 = wsCopy.Range("A2:M" & wsCopy_Transfer)
              Target2.Copy
              wsMSTR_Transfer.Range("A" & rowMSTR_Transfer).PasteSpecial Paste:=xlValues
              rowMSTR_Transfer = wsMSTR_Transfer.Cells(Rows.Count, 1).End(xlUp).Row + 1
      '                   **************************************************************************************************************
          ''THIS IS COMMENTED OUT BECAUSE THERE IS NO XXX2 FUNDING - COMMENT BACK IN IF FUNDING OCCURS''
      '                   **************************************************************************************************************
      '                   ElseIf wsCopyName = "XXX2" Then
      '                        wsCopy_XXX2 = wsCopy.Cells(Rows.Count, 1).End(xlUp).Row
      '                        Set Target4 = wsCopy.Range("A2:M" & wsCopy_XXX2)
      '                        Target4.Copy
      '                        wsMSTR_Transfer.Range("A" & rowMSTR_Transfer).PasteSpecial Paste:=xlValues
      '                        rowMSTR_Transfer = wsMSTR_Transfer.Cells(Rows.Count, 1).End(xlUp).Row + 1
      '                   **************************************************************************************************************
          ''THIS IS COMMENTED OUT BECAUSE THERE IS NO XXX1 FUNDING - COMMENT BACK IN IF FUNDING OCCURS''
      '                   **************************************************************************************************************
      '                   ElseIf wsCopyName = "ENTER XXX1 FUNDING SHEET NAME" Then
      '                        wsCopy_XXX1 = wsCopy.Cells(Rows.Count, 1).End(xlUp).Row
      '                        Set Target5 = wsCopy.Range("A2:M" & wsCopy_XXX1)
      '                        Target5.Copy
      '                        wsMSTR_Transfer.Range("A" & rowMSTR_Transfer).PasteSpecial Paste:=xlValues
      '                        rowMSTR_Transfer = wsMSTR_Transfer.Cells(Rows.Count, 1).End(xlUp).Row + 1
          ElseIf wsCopyName = "Travel-Events Calendar" Or wsCopyName = "Travel - Events Calendar" Then
              wsCopy_Travel = wsCopy.Cells(Rows.Count, 1).End(xlUp).Row
              wsCopy.ListObjects(1).AutoFilter.ShowAllData
              Set Target3 = wsCopy.Range("A5:L" & wsCopy_Travel)
              Target3.Copy
              wsMSTR_Travel.Range("A" & rowMSTR_Travel).PasteSpecial Paste:=xlValues
              rowMSTR_Travel = wsMSTR_Travel.Cells(Rows.Count, 1).End(xlUp).Row + 1
          Else
          End If
          End With
      Next
      End Sub
      
      

      귀중한 도움을 주신 @ Wookies-Will-Code에게 감사드립니다.

  • 이전 java - 주석에 포함 된 경우 @JsonSerialize 및 @JsonDeserialize가 작동하지 않습니다
  • 다음 ios - 앱과 오늘 위젯간에 이미지 리소스 공유