从inputbox提示符(wb1)获取范围,将值传输到定义的范围(wb2)

试图写一个macros,它可以帮助将数千个旧文件的信息传输到新格式的文件。 大多数是标准的,所以我有一个macros,可以将“旧”书上的指定范围的值转移到“新书”上的指定范围,相对无痛苦(感谢这个网站)。

但是,一些旧文件格式不正确,范围与我的macros中指定的不匹配。 所以,我决定在这些情况下让用户定义要复制的范围是有意义的。

我已经尝试将值分配为=,并且我尝试了复制粘贴,至今都不工作。 任何线索将不胜感激。

这是迄今为止的代码(这只是一个迭代,就像我说过的,我一直在尝试一堆不同的东西):

sub magic_select() Dim wb As Workbook, wb2 As Workbook Dim vfile As Variant Dim name As String Dim oldname As String Dim Cvalves, Ovalves, breakers, safety_inst, procedure_ID, Pvalves, Pbreakers, electest As String 'set source workbook Set wb = ActiveWorkbook 'open target workbook vfile = Application.GetOpenFilename("Excel-Files,*.xls*", _ 1, "Select One File to Open", , False) 'if nothing selected, exit sub If TypeName(vfile) = "Boolean" Then Exit Sub 'open selected file Workbooks.Open vfile 'set target workbook Set wb2 = ActiveWorkbook 'procedure_ID = Application.InputBox(Prompt:="select procedure ID: one cell", Type:=8) Cvalves = Application.InputBox(Prompt:="select valves to be locked closed", Type:=8) Ovalves = Application.InputBox(Prompt:="select valves to be locked open", Type:=8) breakers = Application.InputBox(Prompt:="select breakers to be opened and locked out", Type:=8) safety_inst = Application.InputBox(Prompt:="select Special Safety Instructions", Type:=8) Pvalves = Application.InputBox(Prompt:="select valves from Procedure(page 2)", Type:=8) Pbreakers = Application.InputBox(Prompt:="select breakers from Procedure (page2)", Type:=8) electest = Application.InputBox(Prompt:="select Electrical Test Procedure", Type:=8) 'copies all the appropriate values to blank form 'wb is blank form (copy to) 'wb2 is old LOTO form (copied from) 'edit values as needed wb.Worksheets(1).Range("e11, e85").Value = wb2.Worksheets(1).Range("e11").Value wb.Worksheets(1).Range("E21:I45").Value = Range("Cvalves").Value wb.Worksheets(1).Range("E50:I61").Value = Range("Ovalves").Value wb.Worksheets(1).Range("E95:G121").Value = Range("breakers").Value wb.Worksheets(1).Range("a124:a128").Value = Range("breakers").Val wb.Worksheets(1).Range("h70, c132").Value = Range("procedure_ID").Value wb.Worksheets(2).Range("a10:f54").Value = Range("Pvalves").Value wb.Worksheets(2).Range("a60:f89").Value = Range("Pbreakers").Value wb.Worksheets(2).Range("a92:a97").Value = Range("Electest").Value name = wb2.name oldname = "_done_" & name 'resaves old file under new name wb2.SaveAs Filename:="xyz" & oldname, _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'closes old file wb2.Close 'deletes old duplicate file Kill vfile 'Set wb = ActiveWorkbook 'saves as new, separate LOTO form wb.SaveAs Filename:="zyx" & name, _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 're-open blank macro form Workbooks.Open ("C:\Users\me.etc") 'closes new file wb.Close End Sub 

1- Application.InputBox(..., Type:=8)的返回值是一个Range object 。 所以首先,适当地调整你的variables。

 Dim Cvalves As Range, Ovalves As Range, breakers As Range, ' etc.. 

2- Set范围设置为用户select的范围:

  Set Cvalves = Application.InputBox(Prompt:="select valves to be locked closed", Type:=8) ' ^^^ 

3-现在您可以将用户select的范围复制到适当的目的地,即

 CValves.Copy wb.Worksheets(1).Range("E21") 

或者,您可以(最好)直接分配值而不需要复制:

 wb.Worksheets(1).Range("E21").Resize(CValves.Rows.Count, CValves.Columns.Count).Value = CValves.Value2 

你需要按照这个方法用户select的所有范围。 我有一种感觉,这种方法是容易出错,因为用户必须select这么多的范围,可能会犯错误。 但是,如果这是唯一的select,这就是你如何实现它。