탭 이름을 기반으로 파일을 엽니 다?

Question

다음 코드 For 나는 한 통합 문서의 범위에서 데이터를 가져 와서 탭 이름을 기반으로 지정된 폴더에서 찾은 다른 통합 문서에 놓는 것이 좋습니다.

책상 위에있는 폴더에는 "Master, Processor Alex, Processor Sue, Processor Bill"이라는 파일이 4 개 있습니다. Master.xlsm에는 "Skip Me, Alex, Sue, Bill"의 네 개의 탭이 있습니다. Alex et al의 해당 탭에서 통합 문서 마지막 페이지로 전송 된 코드의 범위가 필요합니다.

불행하게도 나는 무릎 꿇기에 F8을 사용하여 단계를 수행 할 수 없기 때문에 어떤 종류의 프로젝트 사이드 바가 열립니다. 그게 나에게 오류를주고 나는 VBA에 익숙하지 않기 때문에 오류를 이해하지 못한다. 하지만이 프로젝트는 나에게 매우 중요합니다.

루프를 사용하여 작업 한 코드를 가져 와서 루프를 사용하여 다시 작성하고 아래받은 탭 이름에서 통합 문서 열기를 시도했습니다. 나는 여기에 어디에도 없었던 곳에 오류가 생겼다.

Sub SheetLoop() 

Dim ws As Worksheet 
Dim SourceWB As Workbook 
Set SourceWB = ThisWorkbook 
Application.ScreenUpdating = False 

For Each ws In Worksheets 
    If ws.Name <> "Skip Me" Then     
    ws.Activate 
    ws.Select 
    Range("A2:M10").Select 
    Selection.Copy 

    Workbooks.Open ("C:\Users\Scott\Desktop\VBA Proj\" & ws.Name & ".xlsx")'<---- -??? 

    Worksheets(Worksheets.Count).Select 'Selects last worksheet page 

    'Selects destination looking for first blank cell in "B" 
    Set ws = ActiveSheet 
    For Each Cel In ws.Columns(2).Cells 
     If IsEmpty(Cell) = True Then Cell.Select: Exit For 
    Next Cel ' corrected Cell > Cel 

    ActiveSheet.Paste    'Pastes selection  
    Application.CutCopyMode = False 'Clears Clipboard for next copy action 
    End If 
Next ws 

End Sub 

Answer 1

자신의 코드를 작성해야합니다. 고장난 부분을 해결할 수 있도록 도와 드리지만 여기에 코드를 작성하지 않았습니다. 책에서 장을 반복하는

간단한 코드는 다음과 같습니다, 새 통합 문서가 동일한 폴더에 WKB 및 WKS 가정, 시트 이름에서 통합 문서 경로를 생성하는 간단한 코드가 정의 된

dim wkb as excel.workbook 
dim wks as excel.worksheet 
set wkb = thisworkbook ' or activework or whatever 
for each wks in wkb.sheets ' iterate through the sheets 
    msgbox "Now on sheet " & wks.name 
next 

입니다

코드와 책, 그리고 WKS의 시트 이름으로, 열이 책의 이름입니다 : 당신이 알고있는 가정,

dim mypath as string, newname as string, extn as string 
extn = ".xlsx" ' or ".xls" or whatever 
mypath = wkb.path 
if not right(mypath,1) = "\" then mypath = mypath & "\" 
newname = mypath & wks.name & extn 

간단한 코드는 통합 문서를 열 이름입니다 :

dim wkbdata as excel.workbook 
set wkbdata = workbooks.open(newname) 

Answer 2

내가하고 싶은 일이 완전히 명확하지 않습니다. 하지만 여기에 파일을 열어주는 코드가 있습니다. 이 파일 이름을 사용하여 원하는대로 사용할 수 있습니다.

For i = 1 to ActiveWorkbook.Worksheets.Count 
    Workbooks.Open "C:\FilePath\" & Worksheets(i).Name & ".xlsx" 

Next i 

이 정보가 도움이되기를 바랍니다. 코드의 일부분을 게시하거나보다 자세하게 설명하면 여기 사람들이 더 잘 도와 줄 수 있습니다.

Answer 3

나는 위의 코드에 정말 가까운 것을 포함하고 있습니다. 통합 문서에서 테스트 한 기본 루프를 사용하여 처음부터 시작하여 이전 버전의 요소를 삭제하기 시작했습니다. 그 때 그것은 부서졌다.

Answer 4

"시스템을 통과시키지 마십시오"라는 말은 거의 의미가 없으며 F8과 같은 VBA 단축키를 의미합니다. 다른 Windows 10 기능을 엽니 다.

나는 그것을 필요로하는 다른 사람들의 공헌으로 아래를 게시하고 있습니다. 작동합니다. Mr.Excel 포럼의 Tonyyy에게 감사드립니다. 나는 다음 섹션에서 일할 수 있도록 라인을 줄였습니다. 그래서 어딘가에 잘못된 " '"가있을 수 있습니다. 나는 그들을 모두 가지고 있다고 생각해.

Sub UpdatebyLoop_2() 
Application.ScreenUpdating = False 
Dim SourceWB As Workbook, destinationWB As Workbook 
Dim ws As Worksheet 


       'Data Transfer Section 
Set SourceWB = ThisWorkbook 
On Error GoTo errHandler 
For Each ws In SourceWB.Worksheets 
If ws.Name <> "Skip me" And ws.Name <> "Skip me also" Then 
    Set destinationWB = Workbooks.Open(SourceWB.Path & "\" & ws.Name & ".xlsx") 
    ws.Range("B6:AK30").Copy Destination:=destinationWB.Sheets (Sheets.Count). _ 
     Cells(destinationWB.Sheets(Sheets.Count).Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) 
      destinationWB.Close savechanges:=True 

    End If 
'Repeat on next worksheet 
Next ws 
With Application 
    .CutCopyMode = False 
    .ScreenUpdating = True 
End With 
Exit Sub 

errHandler: 
    'MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _ 
    "Sorry, it seems the worksheet name - " & ws.Name & " - does not match a workbook name." 
    Resume Next 

최종 하위