폴더의 모든 파일에서 데이터 복사

폴더에있는 모든 Excel 파일을 열고 각 파일의 모든 첫 번째, 57 번째, 72 번째, 73 번째 및 74 번째 행을 동일한 통합 문서로 복사해야합니다. 이폴더의 모든 파일에서 데이터 복사

편집을 작동하는 경우

MyPath = "C:\foldername" 'the folder 
strFilename = Dir(MyPath & "\*.xls") 'all excel files in folder 

Do Until strFilename = "" 
... 
strFilename=Dir() 
Loop

이 말해 :

Dim i As Integer 
Dim wbOpen As Workbook 
Dim MyPath As String 
Dim strFilename As String 
MyPath = "C:\foldername" 'the folder 
strFilename = Dir(MyPath & "\*.xls") 'all excel files in folder 

Do Until strFilename = "" 

    'here it gives an error, saying it can't open file, 
    ' even though it apparently has found it 
    wbOpen = Workbooks.Open(strFilename) 

    'copy relevant text 
    Workbooks(2).Activate 
    Sheets("blad1").Rows(1, 57, 72, 73, 74).Copy 
    Workbooks(1).Activate 
    'select the first empty row 
    irow = ActiveSheet.UsedRange.Rows.Count + 1 
    'insert the copied 
    irow.Insert Shift:=xlDown 
    'close the workbook without saving 
    Workbooks(2).Close SaveChanges:=False 
    Close 

Loop

출처

2012-10-12 Seeb

가 이런 식으로 시도 :

이이 내가 지금까지 무엇을 가지고 수정을 Sheets("blad1").Rows(1, 57, 72, 73, 74).Copy 에 Sheets("blad1").Rows("1, 57, 72, 73, 74").Copy

출처

2012-10-12 16:15:49

아니요, 여전히 작동하지 않습니다. 이상하게도이 오류는 계속 발생합니다. "(올바른 파일 이름 .xls)을 찾을 수 없습니다." 라인 Workbooks.Open (strFilename가) – Seeb

글쎄, 나는 다음 시도했다 : strFilename DIR =() Workbooks.Open (MYPATH & "\"& strFilename) '나머지는 동일 첫 번째 파일을 엽니 다 , 그런 다음 파일이 진정으로 xls 파일이 아니라고 말합니다 .. – Seeb

이전과 같은 오류가 나타납니다. 문제는 수동으로 통합 문서를 열려고하면 같은 msg가 나타납니다. "파일의 확장자와 파일 형식이 같지 않습니다. 아마도 신뢰할 수없는 소스 파일 인 것일 수 있습니다. 파일을 열려고합니까? ? " – Seeb

폴더의 모든 파일에서 데이터 복사

답변

관련 문제