>

.xlsm 형식의 Excel 파일을 포함하는 4 개의 하위 폴더가 있고 상위 폴더에 마스터 Excel 통합 문서가 있습니다. 내 프로그램은 하위 폴더에있는 모든 Excel 통합 문서의 sheet1에있는 공통 비 연속 셀 (A1, B5, C6)의 데이터를 복사하여 마스터 Excel 통합 문서 시트 ( "서식 파일")에 붙여 넣습니다. 아래에는 폴더를 반복하고 xlsm 형식으로 한 번에 하나씩 Excel 파일을 여는 코드 추출이 있습니다. 그런 다음 첫 번째 통합 문서에서 A1, B5, C6 셀을 복사하여 닫고 A2, B2 및 C2의 마스터 통합 문서 템플릿 시트에 붙여 넣은 다음 다음 Excel 파일 사본 A1, B5, C6을 엽니 다. 마스터 통합 문서의 템플릿 시트에서 A3, B3, C3에 붙여 넣습니다. 이 프로세스는 하위 폴더의 모든 Excel 파일을 반복 한 후에 계속됩니다

'Loop through the collection
    For Each myItem In collSubFolders
'Loop through Excel workbooks in subfolder
      myFile = Dir(myFolder & myItem & "\*.xlsm*")

     Do While myFile <> “”
'Open workbook
     Set wbk = Workbooks.Open(Filename:=myFolder & myItem & " \ " & myFile)
'Copy data from the opened workbook
      lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
      lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
      ActiveSheet.Range("A1,B5,C6").Copy
'Close opened workbook without saving any changes
     wbk.Close SaveChanges:=False
           erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      ActiveSheet.Cells(erow, 1).Select
      ActiveSheet.Paste
     ActiveWorkbook.Save
     Application.CutCopyMode = False
       myFile = Dir
     Loop
     Next myItem
       Application.ScreenUpdating = True

    End Sub

  • 답변 # 1

    이것이 제대로 작동하는 방법입니다 :

    Option Explicit
    Sub Test()
        Dim wb As Workbook 'add a reference for the master workbook
        Dim CopyCellA As Range
        Dim CopyCellB As Range
        Dim CopyCellC As Range
        Set wb = ThisWorkbook 'if the master workbook is the one having the code
    
        'Loop through the collection
        For Each myItem In collSubFolders
        'Loop through Excel workbooks in subfolder
            myFile = Dir(myFolder & myItem & "\*.xlsm*")
            Do While myFile <> “”
                'Open workbook
                Set wbk = Workbooks.Open(Filename:=myFolder & myItem & " \ " & myFile)
                'Copy data from the opened workbook
                With wbk.Sheets(1) '1 is the first sheet on the book, change this if not
                    'The next 2 lines are useless because you are not using lastrow or lastcolumn anywhere
                    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'you also need to reference the rows.count
                    LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column 'same as above
                    Set CopyCellA = .Range("A1")
                    Set CopyCellB = .Range("B5")
                    Set CopyCellC = .Range("C6")
                End With
                With wb.Sheets("MySheet") 'change MySheet for the sheet name where you are pasting
                    erow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(erow, 1) = CopyCellA 'no need to select
                    .Cells(erow, 2) = CopyCellB
                    .Cells(erow, 3) = CopyCellC
                End With
                'Close opened workbook without saving any changes
                wbk.Close SaveChanges:=False
                wb.Save
                Application.CutCopyMode = False
                myFile = Dir
            Loop
        Next myItem
        Application.ScreenUpdating = True
    End Sub
    
    

관련 자료

  • 이전 javascript - 접두사로 모든 ​​data- * 속성을 얻는 방법
  • 다음 node.js - 많은 MondoDB 데이터베이스 접근 방식의 NodeJS 샤딩 아키텍처