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

我对VBA相当陌生，需要项目帮助。 我需要编写一个macros读取C列中的工作表名称，并将源工作簿中的值粘贴到目标工作簿中的一个范围，该范围在D列中指定。

例如，需要将MyWorkbook书籍Sheet2中的数据复制粘贴到其工作簿Sheet2的范围内。 范围和图纸编号信息存储在一个单独的工作簿中的地方。

编辑：我已经添加了wbOpen的样子的图片。 这是这里。

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

像这样的东西（未经testing，但应该给你一个想法）

 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