脚本运行但不做任何事情

该脚本运行没有错误，但它不会做它应该做的事情，实际上它不会改变文档中的任何东西。 我testing一个零件，testing软件吐出保存在一个名为Location 1,2,3,4的文件夹中的4个工作簿。 然后，我在脚本中打开一个模板“alpha”，它使用来自以前工作簿的数据来显示平均值并显示数据的走势。 macros然后被一个button激活，它应该粘贴在alpha工作簿到下一个空行。 行是6个单元格和3个单元格。

显然，我需要10代表图片之前，所以inheritance人的图片链接….在图片一个testing完成，我有一个testing（行）的macros，但我不能得到它重复粘贴到下一个空的下来。 如果有更好的方法，请让我知道哈哈。 https://drive.google.com/file/d/0B9n6BtJ4Med8NlVGa2FySzEtMGM/view?usp=sharing

Sub DataTransfer() 'simplified to 2 workbooks Dim w As Workbook 'Test_Location 1 Dim Alpha As Workbook 'Template Dim Emptyrow As Range Set w = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_1.xls") Set Alpha = Workbooks("FRF_Data_Sheet_Template.xlsm") Set EmptyrowC = Range("C" & Alpha.Sheets("DataInput").UsedRange.Rows.Count + 1) w.Sheets("Data").Range("I3:K7").Copy With Alpha.Sheets("DataInput") EmptyrowC.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = True End With End Sub 

我也试图做一个If语句，但没有得到的地方。

  Sub DataTransfer() Application.ScreenUpdating = False Dim w As Workbook 'Test_Location 1 Dim x As Workbook 'Test_Location 2 Dim y As Workbook 'Test_Location 3 Dim z As Workbook 'Test_Location 4 Dim Alpha As Workbook 'Template Dim Emptyrow As Long 'Next Empty Row Set w = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_1.xls") Set x = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_2.xls") Set y = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_3.xls") Set z = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_4.xls") Set Alpha = Workbooks("FRF_Data_Sheet_Template.xlsm") If Columns("C").Value = "" Then Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = w.Sheets("Data").Range("I3:K7").Value Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = x.Sheets("Data").Range("I3:K7").Value Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = y.Sheets("Data").Range("I3:K7").Value Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = z.Sheets("Data").Range("I3:K7").Value w.Close False x.Close False y.Close False z.Close False End If 

Application.ScreenUpdating = True End Sub

Answer 1

像这样的东西：

 Option Explicit Sub DataTransfer() Const FPATH As String = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\" Application.ScreenUpdating = False Dim wb As Workbook Dim shtAlpha As Worksheet 'Template Dim locs, loc Dim rngDest As Range locs = Array("location_1.xls", "location_2.xls", _ "location_3.xls", "location_4.xls") Set shtAlpha = Workbooks("FRF_Data_Sheet_Template.xlsm").Sheets("DataInput") 'set the first data block destination Set rngDest = shtAlpha.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(5, 3) For Each loc In locs Set wb = Workbooks.Open(Filename:=FPATH & loc, ReadOnly:=True) rngDest.Value = wb.Sheets("Data").Range("I3:K7").Value wb.Close False Set rngDest = rngDest.Offset(0, 3) 'move over to the right 3 cols Next loc Application.ScreenUpdating = True End Sub 

我不确定你对C列的检查意味着什么，所以我把它留给了…

Answer 2

我已经做出了许多（合理的…）假设，并重写了第一个代码，以使用设置的variables，并定义各个范围源于的特定工作簿。

 Sub DataTransfer() Dim w As Workbook 'Test_Location 1 Dim x As Workbook 'Test_Location 2 Dim y As Workbook 'Test_Location 3 Dim z As Workbook 'Test_Location 4 Dim Alpha As Workbook 'Template Dim EmptyrowC As Range, EmptyrowF As Range, EmptyrowI As Range, EmptyrowL As Range Application.ScreenUpdating = False Set w = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_1.xls") Set x = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_2.xls") Set y = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_3.xls") Set z = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_4.xls") Set Alpha = Workbooks("FRF_Data_Sheet_Template.xlsm") With Alpha.Sheets("DataInput") Set EmptyrowC = .Cells(Rows.Count, "C").End(xlUp).Offset(1, 0) Set EmptyrowF = .Cells(Rows.Count, "F").End(xlUp).Offset(1, 0) Set EmptyrowI = .Cells(Rows.Count, "I").End(xlUp).Offset(1, 0) Set EmptyrowL = .Cells(Rows.Count, "L").End(xlUp).Offset(1, 0) w.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowC x.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowF y.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowI z.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowL w.Close False x.Close False y.Close False z.Close False End With Application.ScreenUpdating = True End Sub 

你是否绝对需要一个Range.PasteSpecial方法并不是100％清楚，所以你开始哟，我select了更简单的Range.Copy方法。 如果这不够，那么直接价值转移将优先于复制，粘贴特殊值。