VBA將數據從一張表複製到另一張

Question

我是VBA的新手，需要項目幫助。我需要編寫一個讀取列C中的工作表名稱的宏，並將源工作簿中的值粘貼到目標工作簿中的範圍，該範圍在列D中指定。

因此，例如，需要複製Myworkbook書籍Sheet2中的數據，並將其粘貼到他們的工作簿Sheet2範圍內。範圍和圖紙編號信息存儲在單獨的工作簿中的地方。

編輯：我添加了一張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