여러 파일의 탭 이름을 기반으로 Excel 복사/붙여 넣기 데이터

Question

나는 (잘하면) 쉬운 상황이 있습니다. VBA 매크로를 사용하여이 프로세스를 자동화하려고합니다.

내가 Excel 스프레드 시트를 가지고 다음과 같은 이름을 가진 여러 개의 탭 (이 그냥 예입니다)가 (의이 data.xls를 부르 자) :

Sucralose 
Cellulose 
Dextrose 

각 탭은 단순히 데이터의 열이 그 안에. 데이터의 모든 탭을 다른 형식의 다른 스프레드 시트로 복사하는 간단한 방법이 있는지 알고 싶습니다. 탭 이름을 기반으로 추가 작업을 수행합니다 (reduction.xls). 내가 탭 자당, 포도당, reduction.xls에서 같은 이름 탭의 열 F (기존) TO data.xls FROM 셀룰로오스의 열 A를 복사 할

[자당, 포도당 : 예를 들어

, Cellulose].

data.xls의 각 탭에서 열이 reduction.xls에 붙여 넣기되는 "true/false"유형 명령문을 찾고 있는데, 정확히 동일한 이름의 탭이 있다고 가정하고 사용자와 상호 작용할 필요가 없다고 가정합니다. .

Answer 1

코드는 아래에 게시 된 다음과 같은 기능이 있습니다

1. 그것은 쉽게 탭의 임의의 수를 처리하기위한 준비를. 표시된대로 3 줄만 수정해야합니다. 1) 탭 이름 목록, 2) 원본 통합 문서의 이름, 3) 대상 통합 문서의 이름.
2. 대상 통합 문서의 누락 된 탭에 대해 "보호"됩니다.
3. 구조가 자명하지만 (주관적인 설명 일 수도 있음)

.

Sub copy_tab(ByVal wsName As String) 
    Dim wbnamesrc As String 
    Dim wbnametrg As String 
    wbnamesrc = "source.xlsm"  ' Change this line 
    wbnametrg = "Book8"  ' Change this line 
    Dim wbsrc As Workbook 
    Dim wbtrg As Workbook 
    Set wbsrc = Workbooks(wbnamesrc) 
    Set wbtrg = Workbooks(wbnametrg) 

    If (WorksheetExists(wsName, wbnametrg)) Then 
     Dim rngsrc As Range 
     Dim rngtrg As Range 
     Application.CutCopyMode = False 
     wbsrc.Worksheets(wsName).Range("A:A").Copy 
     wbtrg.Worksheets(wsName).Range("A:A").PasteSpecial 
    End If 
End Sub 

Sub copy_tabs() 
    Dim wslist As String 
    Dim sep As String 
    wslist = "Sucralose|Cellulose|Dextrose|Sheet1"  ' Change this line 
    sep = "|" 
    Dim wsnames() As String 
    wsnames = Split(wslist, sep, -1, vbBinaryCompare) 

    Dim wsName As String 
    Dim wsnamev As Variant 
    For Each wsnamev In wsnames 
     wsName = CStr(wsnamev) 
     Call copy_tab(wsName) 
    Next wsnamev 
End Sub 

Public Function str_split(str, sep, n) As String 
' From http://superuser.com/questions/483419/how-to-split-a-string-based-on-in-ms-excel 
' splits on your choice of character and returns the nth element of the split list. 
    Dim V() As String 
    V = Split(str, sep) 
    str_split = V(n - 1) 
End Function 

' From http://stackoverflow.com/a/11414255/2707864 
Public Function WorksheetExists(ByVal wsName As String, ByVal wbName As String) As Boolean 
    Dim ws As Worksheet 
    Dim ret As Boolean 
    ret = False 
    wsName = UCase(wsName) 
    For Each ws In Workbooks(wbName).Worksheets 
     If UCase(ws.Name) = wsName Then 
      ret = True 
      Exit For 
     End If 
    Next 
    WorksheetExists = ret 
End Function 

Answer 2

개인적으로 다른 VBA를 열고 다른 2 개의 상호 작용하는 통합 문서와 별도로 열고 실행할 수 있습니다.

따라서 3 차원을 정의했습니다. wbk = 코드가 포함 된 통합 문서. wbk1 = 복사 할 원본 통합 문서. wbk2 - 붙여 넣을 대상 통합 문서입니다.

파일 위치와 범위를 편집해야합니다. A1 : A100 만 원할 경우 매번 동일한 수의 행이 있다고 가정 해보십시오. 그렇지 않다면 행 수를 예상보다 멀리 늘리면 행 수가 증가하므로 놓치지 않도록하십시오. 새 통합 문서에

1. 이동
2. 홀드 Alt 키와
3. 삽입을 클릭 키를 눌러 F11 -
을 필요에 따라> 모듈
4. 창 및 업데이트 파일 위치 및 복사/붙여 넣기 범위에서 다음 코드를 붙여 넣습니다

5. 를 눌러 매크로 실행 (녹색 재생 버튼) 또는 코드

   Sub DataTransfer() 
   
   Dim wbk, wbk1, wbk2 As Workbook 
   
       'Workbook with VBA in it. 
       Set wbk = ActiveWorkbook 
   
       'Define destination workbook 
       Set wbk1 = Workbooks.Open("C:\data.xls") 
       'Define Source workbook 
       Set wbk2 = Workbooks.Open("C:\reduction.xls") 
   
   
   
   
       Call wbk1.Worksheets("Sucralose").Range("A1:A100000").Copy 
       Call wbk2.Worksheets("Sucralose").Range("F1:F100000").PasteSpecial(xlPasteValues) 
       Application.CutCopyMode = False 
   
   
       Call wbk1.Worksheets("Cellulose").Range("A1:A100000").Copy 
       Call wbk2.Worksheets("Cellulose").Range("F1:F100000").PasteSpecial(xlPasteValues) 
       Application.CutCopyMode = False 
   
   
       Call wbk1.Worksheets("Dextrose").Range("A1:A100000").Copy 
       Call wbk2.Worksheets("Dextrose").Range("F1:F100000").PasteSpecial(xlPasteValues) 
       Application.CutCopyMode = False 
   
       End Sub 
   

012,351,641에 커서와 F5를 명중