파일 폴더에서 정보를 복사하고 단일 통합 문서로 정보를 컴파일하는 VBA

Question

단일 폴더 위치의 여러 통합 문서에서 다양한 범위의 데이터를 가져 와서 해당 정보를 모두 지나치게 미리 준비된 단일 워크 시트에 저장하려고합니다. 기존 파일.

Function GetFileList(FileSpec As String) As Variant 

Dim FileArray() As Variant 
Dim FileCount As Integer 
Dim FileName As String 

On Error GoTo NoFilesFound 

FileCount = 0 
FileName = Dir(FileSpec) 
If FileName = "" Then GoTo NoFilesFound 

Do While FileName <> "" 
    FileCount = FileCount + 1 
    ReDim Preserve FileArray(1 To FileCount) 
    FileArray(FileCount) = FileName 
    FileName = Dir() 
Loop 
GetFileList = FileArray 
Exit Function 

NoFilesFound: 
    GetFileList = False 
End Function 

Sub ClearCosting() 

Dim var As Variant 
Dim loc As String 
loc = "C:\Users\m.raby\Desktop\testfolder" 
var = GetFileList(loc & "*.xls*") 

Dim StrFile As Variant 
For Each StrFile In var 

    Workbooks.Open (loc & StrFile) 

     sh.Activate 
     On Error Resume Next 
     Set uCost = Cells.Find(What:="Run rate", After:=[A1], LookIn:=xlFormulas, _ 
     LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False) 
     Range(Cells(uCost.Row + 1, uCost.Column - 4), Cells(uCost.Row.End(xlDown), uCost.Column + 8)).Copy 
     On Error GoTo 0 

Next StrFile 

End Sub 

은 내가 지금에 부착하고하는 데이터의 검색입니다 :

지금까지, 나는 파일의 목록을 얻을 수있는 기능을 가지고있다. 정보를 한 줄 아래에 4 개의 텍스트를 "Run rate"텍스트 왼쪽에 놓고 해당 셀에서 행의 빈 셀 앞에있는 마지막 셀과 오른쪽에 8 개의 열에 복사하려고합니다. .

이 정보를 복사하여 바탕 화면에있는 "sampletest.xlsx"라는 통합 문서에 각 정보 행의 파일 이름과 함께 붙여 넣기를 원합니다. 첫 번째 시트 만 (모든 통합 문서의 활성 시트 여야 함) 완료 한 후에는 다음 통합 문서로 이동하여 "sampletest.xlsx"에 다음 정보를 추가하십시오.

첫 번째 워크 시트에 대해서만이 범위를 모두 캡처 한 다음 파일 이름을 캡처하고이 모든 정보를 단일 통합 문서에 폴더를 반복하면서 어떻게 추가 할 수 있습니까?

Answer 1

이것은 전체 코드는 아니지만 도움이 될 것입니다.

여러 통합 문서를 사용하여 작업하는 경우 해당 작업을 추적 할 수 있습니다. 주기에서 다음

Dim CurrWB As Workbook 
Set CurrWB = ActiveWorkbook 

:

이

R1 = 1 
Do While WB.Sheets("Sheet name").Cells(R, 2) <> "Starting text" 
    R1 = R1 + 1 
Loop 

R2 = R1 + 1 
Do While WB.Sheets("Sheet name").Cells(R2, 2) <> "Ending text" 
    R = R + 1 
Loop 

For R = R1 to R2 
    CurrWB.Sheets("Report").Cells(RReport, 3) = WB.Sheets("Report").Cells(R, 3) 
    RReport = RReport + 1 
Next R