如果单元格等于值，则复制Excel行 [英] Copy Excel Row if Cell is equal to a value

问题描述

我正在尝试复制并粘贴到其他工作簿中，并将该数据分布在新工作簿内部的不同工作表上.我已经使VBA正常运行，但是它只能在大约25％的时间内工作.我不断收到运行时错误'1004':Range类的选择方法失败"的错误.

I'm trying to copy and paste into a different workbook and spread that data over different sheets inside of the new workbook. I've got my VBA working, but it only works about 25% of the time. I continually get an error on "Run-time error '1004': Select method of Range class failed".

这是脚本:

Sub CopyData()

    Dim i As Range
    For Each i In Range("A1:A1000")

        Windows("data_1.xls").Activate
        Sheets("data_1").Activate
        If i.Value = 502 Then
            i.Select
            ActiveCell.Rows("1:1").EntireRow.Select
            Selection.Copy
            Windows("DataOne.xls").Activate
            Sheets("502").Range("A39").End(xlUp).Offset(1, 0).PasteSpecial
        End If
        If i.Value = 503 Then
            ........
        End If
     Next i
End Sub

每次都会在i.Select上发生故障.我是否需要将Next i带到每个End If的末尾?

The failure happens on i.Select every time. Do I need to bring Next i up to the end of every End If?

推荐答案

如果您只想传输值，则无需使用激活"，选择"或复制/粘贴.

You don't need to use Activate, Select, or copy/paste if you just want to transfer values.

Sub CopyData()

    Dim i As Range
    Dim srcBook as Workbook
    Dim destBook as Workbook

    Application.ScreenUpdating = False

    Set srcBook = Workbooks("data_1.xls")
    Set destBook = Workbooks("DataOne.xls")

    For Each i In srcBook.Sheets("data_1").Range("A1:A1000")
        Select Case i.Value
            Case 502
                destBook.Sheets("502").Range("A39").End(xlUp). _
                    Offset(1, 0).EntireRow.Value = i.EntireRow.Value
            Case 503
                destBook.Sheets("503").Range("A39").End(xlUp). _
                    Offset(1, 0).EntireRow.Value = i.EntireRow.Value
            Case 504
                'etc
            Case Else 
                'do nothing/ or do something for non-matching
        End Select
     Next i

    Application.ScreenUpdating = True
End Sub

如果我对您的If/Then结构和值的目的地有了更多的了解，则可以将其进一步简化(它们全部都指向同一个文件中的工作表名称，该名称对应于i的值吗?因此，这可能更加简单.

This could maybe be further simplified if I knew more about your If/Then structure and the destination of the values (are they all going to a sheet name in the same file, which corresponds to the value of i? If so, this could be even more simple.

我很好奇为什么要循环1000行，而只写A39(.End(xlUp))...

I am curious why you're looping a range of 1000 rows, but only writing to a range of A39 (.End(xlUp))...

评论更新:

Sub CopyData()

    Dim i As Range
    Dim srcBook as Workbook
    Dim destBook as Workbook
    Set srcBook = Workbooks("data_1.xls")
    Set destBook = Workbooks("DataOne.xls")

    For Each i In srcBook.Sheets("data_1").Range("A1:A1000")
        destBook.Sheets(Cstr(i)).Range("A:A").End(xlUp).Offset(1,0). _
            EntireRow.Value = i.EntireRow.Value
     Next i
End Sub

您可能不必担心ScreenUpdating如此大的数组，并且使用这种直接方法来往/往目的地进行写入，它不像连续选择，激活，复制/粘贴，然后再次选择，等等.

You probably don't need to worry about ScreenUpdating with this size of an array, and using this direct method to write from/to the destination, it's not nearly as resource-intensive as continuously selecting, activating, copying/pasting and then selecting again, etc.

这篇关于如果单元格等于值，则复制Excel行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！