2017-02-20 1 views
-1

단일 셀 값을 기준으로 수천 개의 엑셀 (2016) 시트가 색인되어야합니다. 워크 북에는 워크 시트가 하나만 있으며 데이터는 항상 D2 셀에 있습니다.VBA : 1 셀에서 마스터

두 번째 열의 마스터 파일에 D2를 복사하고 첫 번째 열에 관련 파일의 이름을 복사하고 싶습니다. 개별 Excel 파일은 이미 하위 폴더로 분리되어 있으며 때로는 5 개의 폴더로 나뉘어져 있습니다.

나는 코딩에 새로운 것이므로 단계별로 설명 할 수 있다면 보너스 포인트가됩니다. 따라하고 배우고 싶습니다.

도움을 주셔서 감사합니다.

편집 :

내가 전에 시트를 활성화 않았던 물건, 다음, 변경된 파일 다른 통합 문서를 활성화. 나는 다른 워크 시트를 활성화하지 않기 때문에 다음에해야 할 일과 함께 길을 잃어 버렸습니다. 나는 그저 데이터를 가져오고 있습니다. 그들은 심지어 열 필요가 없습니다.

루프가 파일을 호출해야합니다. 그럼 선택해야합니다 : 범위 선택> 복사> 호출 마스터 파일> 활성화> 붙여 넣기> 선택한 셀을 아래로 이동하려면 행 개수에 1을 더하십시오.>

그러나 난 그냥 이름이없는 숫자가 많기 때문에 선행 셀의 이름을 가져온 파일의 파일 이름으로 지정하려고합니다. 이 방법에 대한 도움말을 찾는 것은 파일 이름이나 경로 다음에 워크 시트 내에서 셀의 이름을 지정하는 방법, 매번 변경되는 다른 소스에서 이름을 바꾸는 방법을 찾는 것입니다. 루프

코드 :

Option Explicit 

Sub deeploop() 
Dim objFSO As Object 
Dim objFolder As Object 
Dim objSubFolder As Object 
Dim objFile As Object 
Dim MyFolder As String 
Dim wkbOpen As Workbook 
Dim wkb As Workbook 
Dim wks As Worksheet 
Dim CalcMode As Long 

With Application 
    CalcMode = .Calculation 
    .Calculation = xlCalculationManual 
    .ScreenUpdating = False 
    .EnableEvents = False 
End With 

'Change path 
MyFolder = "C:\Path" 

Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFolder = objFSO.GetFolder(MyFolder) 
Set wkb = ActiveWorkbook 
Set wks = ActiveSheet 

For Each objSubFolder In objFolder.SubFolders 
    For Each objFile In objSubFolder.Files 
     Set wkbOpen = Workbooks.Open(objFile.Path) 


'code 


     wkbOpen.Close savechanges:=True 
    Next objFile 
Next objSubFolder 

With Application 
    .Calculation = CalcMode 
    .ScreenUpdating = True 
    .EnableEvents = True 
End With 


End Sub 
+0

학습 검색 엔진 - 예에 검색을 시작 VBA 또는 복사하는 방법 매크로를 엑셀 ... – 0m3r

+0

은 이미 검색의 많은 일을했습니다. 이미 루핑을 할 수있는 코드가 있지만 개별 파트를 함께 쓰는 방법을 모르므로 요청하는 것이 가장 좋습니다. – Whistler

+0

코드를 게시하여 어떤 부분에 문제가 있는지 알려주십시오. – 0m3r

답변

0

그들은 심지어 필요가 없습니다 그래서 그들을 열지 마십시오

를 열 수 있습니다!

그리고 단지 적절한 셀에 시트 1 "의 이름을 따서 명명된다 엑셀 통합 문서의 모든 수천의 유일한 시트를 가정하고 파일 경로, 파일 이름과 시트 이름

와 완전한 의미 활성 시트에 수식을 넣어 "다음과 같이 행동 할 수 :

Option Explicit 

Sub deeploop() 
    Dim objFSO As Object 
    Dim objFolder As Object 
    Dim objSubFolder As Object 
    Dim objFile As Object 
    Dim MyFolder As String 
    Dim CalcMode As Long 
    Dim ifile As Long 

    With Application 
     CalcMode = .Calculation 
     .Calculation = xlCalculationManual 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 

    'Change path 
    MyFolder = "C:\Path" 

    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set objFolder = objFSO.GetFolder(MyFolder) 

    With ActiveSheet.Range("A1:B1") '<--| it suffices to reference the 'ActiveSheet' object since it belongs to 'ActiveWorkbook' by default 
     For Each objSubFolder In objFolder.SubFolders 
      For Each objFile In objSubFolder.Files 

       .Offset(ifile).Value = Array(objFile.Name, "='" & objSubFolder.Path & "\[" & objFile.Name & "]Sheet1'!$D$2") 
       ifile = ifile + 1 

      Next objFile 
     Next objSubFolder 
    End With 

    With Application 
     .Calculation = CalcMode 
     .ScreenUpdating = True 
     .EnableEvents = True 
    End With 
End Sub 
관련 문제