VBA复制可见单元格仅发出

时间:2016-08-11 06:44:48

标签: vba excel-vba excel

我正在尝试执行我的代码,但它给了我

  

错误1004

虽然我之前使用过类似的语法。

我的目标:我想仅从第一行中包含“MTD”的列复制可见单元格。我想复制的可见单元格仅为75到139行。

'searching for column with "MTD" in it 
Dim NumCol As Integer
Dim Column As Integer

Column = Workbooks("xx.xlsx").Sheets("Sheet1").UsedRange.Columns.Count
For i = 1 To Column
    If Workbooks("xx.xlsx").Sheets("Sheet1").Cells(1, i).Value = "MTD" Then NumCol= i
Next i

'copying visible cells only from Column with MTD and only in rows from 75 to 139
 Dim MyRange As Range

 'Line below is the debugged line
 Set MyRange = Workbooks("xx.xlsx").Sheets("Sheet1").Range(Cells(75, NumCol), Cells(139, NumCol))
 MyRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks ("xy.xlsx").Sheets("Sheet2").Range("A2")

我也尝试过这个,但是出现了424错误。

Dim MyRange As Range

Set MyRange = Workbooks("xx.xlsx").Sheets("Sheet1").Range(Workbooks("xx.xlsx").Sheets("Sheet1").Cells(75,  NumCol), Workbooks("xx.xlsx").Sheets("Sheet1").Cells(139, NumCol))

'This time it debugged this row (error 424)
MyRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("xy.xlsx").Sheets("Sheet2").Range("A2")

任何帮助都将不胜感激。

谢谢:)

2 个答案:

答案 0 :(得分:1)

如果在ActiveWorksheet以外的工作表上存在Range对象,则它的单元格引用也必须限定为该工作表。

Sheet1.Range(Sheet1.Cells(1,1),Sheet1.Cells(1,10))

这不是一个完全限定的参考:

Set MyRange = Workbooks("xx.xlsx").Sheets("Sheet1").Range(Cells(75, NumCol), Cells(139, NumCol))

传递Cells.Address作为参数来解决问题。

Set MyRange = Workbooks("xx.xlsx").Sheets("Sheet1").Range(Cells(75, NumCol).Address, Cells(139, NumCol).Address)

Sub Example()
    Dim NumCol As Integer
    Dim Column As Integer

    With Workbooks("xx.xlsx").Sheets("Sheet1")
        On Error Resume Next
        NumCol = WorksheetFunction.Match("MTD", Rows(1), 0)
        If Err.Number <> 0 Then
            MsgBox "Unable to locate MTD", vbCritical
        End If
        On Error GoTo 0
        'copying visible cells only from Column with MTD and only in rows from 75 to 139
        Dim MyRange As Range

        On Error Resume Next
        Set MyRange = .Sheets("Sheet1").Range(.Cells(75, NumCol), .Cells(139, NumCol)).SpecialCells(xlCellTypeVisible)
        If Err.Number <> 0 Then
            MsgBox "No cells were found", vbCritical
        End If
        On Error GoTo 0

        If Not MyRange Is Nothing Then

            MyRange.Copy Destination:=Workbooks("xy.xlsx").Sheets("Sheet2").Range("A2")

        End If
    End With
End Sub

答案 1 :(得分:1)

尝试更改此行

Set MyRange = Workbooks("xx.xlsx").Sheets("Sheet1").Range(Cells(75, NumCol), Cells(139, NumCol))
MyRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks ("xy.xlsx").Sheets("Sheet2").Range("A2")

Set MyRange = Workbooks("xx.xlsx").Sheets("Sheet1").Range(Cells(75, NumCol), Cells(139, NumCol)).SpecialCells(xlCellTypeVisible)
MyRange.Copy Destination:=Workbooks ("xy.xlsx").Sheets("Sheet2").Range("A2")

我认为应该可以正常工作。