Question

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

例如，它需要复制Myworkbook book的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

VBA将数据从一个工作表复制到另一个工作表

1 个答案: