脚本运行，但不做任何事情 [英] Script Runs but doesn't do anything

问题描述

脚本运行没有错误，但它不会做它应该做的事情，实际上它不会更改文档中的任何内容。我测试一部分，测试软件吐出4个保存在名为Location 1,2,3,4的文件夹中的工作簿。然后，我打开一个模板，脚本中的alpha，它使用前一个工作簿中的数据来显示平均数据并显示数据。然后宏被一个按钮激活，它应该将alpha工作簿粘贴到下一个空行。行分为6个细胞，3个细胞。

The script runs without errors but it doesn't do whats its supposed to do, In fact it doesn't change anything in the documents. I test a part and the testing software spits out 4 workbooks that are saved in a folder named Location 1,2,3,4. Then i open a template, "alpha" in the script, that uses data from the previous workbook to show averages and to show tread of data. The macro is then activated by a button and its supposed to paste in the alpha workbook to the next empty row. The rows are 6 cells apart and 3 cells across.

在图片之前，我需要10个代码，所以会有一个链接到图片....在图片中一个测试完成，我有一个宏测试（行）但是我无法重复并粘贴到下一个空的。如果有更好的方式这样做，请让我知道哈哈。
https://drive.google.com/file/d / 0B9n6BtJ4Med8NlVGa2FySzEtMGM / view？usp = sharing

Apperently i need 10 rep before pictures so heres a link to the picture.... In the picture One test is done, i have a macro for one test (row) but i cant get it to repeat and paste to the next empty down. If there is a better way of doing this please let me know haha. 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语句，但没有在那里。

I also tried to do a If statement but got no where with that.

 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

Application.ScreenUpdating = True End Sub

推荐答案

这样的一个例子：

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列，所以我离开了...

I'm not sure what you mean to do with that check on Column C, so I left that out...

这篇关于脚本运行，但不做任何事情的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！