VBA 将数据从一张表复制到另一张表

Question

我是 VBA 的新手，需要一些项目帮助。我需要编写一个宏来读取 C 列中的工作表名称，并将源工作簿中的值粘贴到目标工作簿中的某个范围，该范围在 D 列中指定。

例如，它需要复制Myworkbook book 的Sheet2 中的数据，并将其粘贴到Theirworkbook 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