2016-06-20 4 views
0

다른 워크 시트를 하나로 병합하려고합니다. 이 코드는 내 디렉토리에있는 모든 파일을 열고 "data"라는 각 시트를 내 masterworkbook 인 "makrotochange.xlsm"에 복사/붙여 넣습니다.붙여 넣은 워크 시트를 하나로 복사하십시오.

Sub LoopThroughFiles() 
    Dim StrFile As String 
    Dim WB As Workbook 
    Dim InputFilePath As String 
InputFilePath = "Z:\1000_Entwicklung\05_PROJECT\0558000_CFT\055800L_CFT_Projektleitung\99_Arbeitsordner PL\Tanverdi, Yigit\SAA\" 
StrFile = Dir(InputFilePath & "*") 

Do While Len(StrFile) > 0 
    Set WB = Workbooks.Open(InputFilePath & StrFile) 
    WB.Activate 
     Sheets("data").Select 
     Sheets("data").Move After:=Workbooks("makrotochange.xlsm").Sheets(23) 
     StrFile = Dir() 
Loop 
End Sub 

각 데이터 워크 시트 행의 서로 다른 양의 ZZ A에서 시작하는 열이와 나는 내 masterworkbook "makrotochange.xlsm"내부에 하나의 워크 시트에이 복사/붙여 넣기 데이터 시트를 병합 할.

어떻게이 워크 시트를 하나로 병합 할 수 있습니까? 이 같은

+0

각 파일에 대한 새 시트를 추가 할 것이 아니라 당신이 할 것 "마스터 시트"에 직접 가져온 데이터를 추가 아니었다면. 마스터 시트의 마지막 행을 결정하고 거기에있는 데이터를 [복사/붙여 넣기] (https://msdn.microsoft.com/en-us/library/office/ff837760.aspx)하십시오. – Ralph

+0

각 워크 시트를 가져 와서 사용 범위 (반드시 'UsedRange'는 아님)를 얻은 다음 메인 WS에 붙여 넣으십시오. 그런 다음 마지막 빈 행을 가져 와서 반복하십시오. 너 뭐 해봤 니? 이 테마의 변형은 적어도 하루에 한 번 질문되므로 검색을 통해 코드/도움말을 찾을 수 있어야합니다. 또한 새 워크 시트에 붙여 넣기 단계를 건너 뛸 수 있으며 시작 부분에서 모두 동일하게 넣을 수 있습니까? – BruceWayne

+0

마스터 통합 문서의 모든 워크 시트 (원격 통합 문서에서 복사 한 "데이터"시트)를 반복 한 다음 해당 시트의 데이터를 복사하여 "마스터"워크 시트에 붙여 넣습니다. 매번 마스터 워크 시트의 "마지막 행"이 어디에 있는지 확인한 다음 그 다음 빈 행의 첫 번째 행에 데이터를 붙여 넣어야합니다. 워크 시트 및 복사/붙여 넣기를 반복하는 방법과 시트에서 마지막으로 비어 있지 않은 행을 찾는 방법에 대한 예제가 많이 있습니다. – PeterT

답변

0

뭔가 :

Sub LoopThroughFiles() 

    Dim StrFile As String 
    Dim WB As Workbook, rng As Range 
    Dim InputFilePath As String 

    InputFilePath = "Z:\1000_Entwicklung\05_PROJECT\0558000_CFT\" & _ 
      "055800L_CFT_Projektleitung\99_Arbeitsordner PL\Tanverdi, Yigit\SAA\" 

    StrFile = Dir(InputFilePath & "*") 

    Do While Len(StrFile) > 0 

     Set WB = Workbooks.Open(InputFilePath & StrFile) 

     'follwoing assumes your data is tabular with no empty rows/columns 
     Set rng = WB.Sheets("data").Range("A1").CurrentRegion 

     'exclude the header row 
     Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count).Offset(1, 0) 

     'copy to the macro workbook at next empty row 
     'NOTE: ColA must always contain a value 
     '  Also assuming there's enough room for the paste... 
     rng.Copy ThisWorkbook.Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 

    Loop 
End Sub 
+0

루프가 끝나지 않습니다. 어떻게 끝낼 수 있습니까? –

관련 문제