VBA 한 시트에서 다른 시트로 데이터 복사

Question

저는 VBA를 처음 접했고 프로젝트에 도움이 필요합니다. C 열의 시트 이름을 읽는 매크로를 작성하고 원본 통합 문서의 값을 열 D에 지정된 대상 통합 문서의 범위에 붙여 넣으십시오.

예를 들어, Myworkbook 서적의 Sheet2에있는 데이터를 읽고 Worksheetbook2의 범위에 붙여 넣습니다. 범위와 시트 번호 정보가 별도의 통합 문서에 저장되는 장소.

편집 : wbOpen의 모습을 추가했습니다. 질문이나 문제 기존 코드 경우의 This is it here.

Option Explicit 
 

 
Sub PasteToTargetRange() 
 

 
    Dim arrVar As Variant 'stores all the sheets to get the copied 
 
    Dim arrVarTarget As Variant 'stores names of sheets in target workbook 
 
    Dim rngRange As Range 'each sheet name in the given range 
 
    Dim rngLoop As Range 'Range that rngRange is based in 
 
    Dim wsSource As Worksheet 'source worksheet where ranges are found 
 
    Dim wbSource As Workbook 'workbook with the information to paste 
 
    Dim wbTarget As Workbook 'workbook that will receive information 
 
    Dim strSourceFile As String 'location of source workbook 
 
    Dim strTargetFile As String 'location of source workbook 
 
    Dim wbOpen As Workbook 'Current open workbook(one with inputs) 
 
    Dim wsRange As Range 'get information from source workbook 
 
    Dim varRange As Range 'Range where values should be pasted 
 
    Dim i As Integer 'counter for For Loop 
 
    Dim wbkNewSheet As Worksheet 'create new worksheet if target workbook doesn't have 
 
    Dim wsTarget As Worksheet 'target workbook worksheet 
 
    Dim varNumber As String 'range to post 
 
    
 
    
 
    
 
    Set wbOpen = Workbooks.Open("WorkbookWithRanges.xlsx") 
 
    
 
    'Open source file 
 
    MsgBox ("Open the source file") 
 
    strSourceFile = Application.GetOpenFilename 
 
     If strSourceFile = "" Then Exit Sub 
 
     Set wbSource = Workbooks.Open(strSourceFile) 
 
     
 
    'Open target file 
 
    MsgBox ("Open the target file") 
 
    strTargetFile = Application.GetOpenFilename 
 
     If strTargetFile = "" Then Exit Sub 
 
     Set wbTarget = Workbooks.Open(strTargetFile) 
 
    
 
    'Activate transfer Workbook 
 
    wbOpen.Activate 
 
    
 

 
    Set wsRange = ActiveSheet.Range("C9:C20") 
 
    
 
    Set arrVarTarget = wbTarget.Worksheets 
 
    
 
     
 
    For Each varRange In wsRange 
 
     If varRange.Value = 'Target workbook worksheets 
 
      varNumber = varRange.Offset(0, -1).Value 
 
      Set wsTarget = X.Offset(0, 1) 
 
      
 
      wsSouce.Range(wsTarget).Value = varNumber 
 
     Else 
 
      wbkNewSheet = Worksheets.Add 
 
      wbkNewSheet.Name = varRange.Value 
 
     End If 
 
    Next 
 
     
 
    
 
End Sub

Answer 1

(검증되지 않은하지만 당신에게 아이디어를 줄 것이다) 이런 식으로 뭔가

Sub PasteToTargetRange() 

    '....omitted 

    Set wsRange = wbOpen.Sheets(1).Range("C9:C20") 

    For Each c In wsRange 

     shtName = c.Offset(0, -1).Value 
     Set wsTarget = GetSheet(wbTarget, shtName) 'get the target sheet 

     wbSource.Sheets(shtName).Range(c.Value).Copy wsTarget.Range(c.Value) 

    Next 

End Sub 

'Get a reference to a named sheet in a specific workbook 
' By default will create the sheet if not found 
Function GetSheet(wb As Workbook, ws As String, Optional CreateIfMissing As Boolean = True) 
    Dim rv As Worksheet 
    On Error Resume Next 'ignore eroror if no match 
    Set rv = wb.Worksheets(ws) 
    On Error GoTo 0 'stop ignoring errors 
    'sheet wasn't found, and should create if missing 
    If rv Is Nothing And CreateIfMissing Then 
     Set rv = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count)) 
     rv.Name = ws 
    End If 
    Set GetSheet = rv 
End Function