Excel VBA如果文件关闭,则打开并粘贴,否则仅粘贴数据

Excel VBA如果文件关闭,则打开并粘贴,否则仅粘贴数据,excel,vba,Excel,Vba,我有VBA宏,可以在打开csv文件后将工作簿中各个选项卡的数据复制到csv文件。这部分工作正常。 但是,我想检查csv文件是否尚未打开,然后打开它并粘贴数据。如果它已打开,则只需粘贴数据 Sub BU_Macro() Dim LR As Long, X As Long ThisWorkbook.Activate With Sheets("Report Group") LR = .Range("A" & .Rows.Count).End(

我有VBA宏,可以在打开csv文件后将工作簿中各个选项卡的数据复制到csv文件。这部分工作正常。 但是,我想检查csv文件是否尚未打开,然后打开它并粘贴数据。如果它已打开,则只需粘贴数据

Sub BU_Macro()



    Dim LR As Long, X As Long
    ThisWorkbook.Activate


    With Sheets("Report Group")

        LR = .Range("A" & .Rows.Count).End(xlUp).Row
        MyCopyRange = Array("A4:A" & LR, "B4:B" & LR, "C4:C" & LR, "D4:D" & LR) 'Put ranges in an array
        MyPasteRange = Array("A1", "B1", "C1", "D1")

        Dim myData As Workbook
        'open target csv file if not already opened
        If CheckFileIsOpen("test.csv") = False Then
            Set myData = Workbooks.Open(strFilePath & "test.csv")

        End If


        Worksheets("test").Select
        Sheets("test").UsedRange.Clear

        If LR > 1 Then
            j = 0
            For X = LBound(MyCopyRange) To UBound(MyCopyRange) 'Loop the array copying and pasting based on element in the array
                .Range(MyCopyRange(j)).Copy
                Sheets("test").Range(MyPasteRange(j)).PasteSpecial xlPasteValuesAndNumberFormats 'xlPasteValues
                j = j + 1
            Next

        Else
            Range("A1") = "No Data Found"
        End If

    End With

End Sub
Function CheckFileIsOpen(chkfile As String) As Boolean

    On Error Resume Next

    CheckFileIsOpen = (Workbooks(chkfile).Name = chkfile)

    On Error GoTo 0

End Function
如果文件已关闭,则会将其打开并粘贴日期,但如果文件已打开,则会出现错误:

Run-time error '9':
Subscript out of range
on line-
Worksheets("test").Select

我想,我无法将代码的重点放在test.csv上。为了添加完整的工作簿/工作表限定符和避免激活/选择,我稍微重新处理了一下

Sub BU_Macro()

    Dim LR As Long, X As Long, MyCopyRange, MyPasteRange, strFilePath
    Dim wb, myData As Workbook, shtPaste As Worksheet

    Set wb = ThisWorkbook

     'Put ranges in an array
    MyPasteRange = Array("A1", "B1", "C1", "D1")

    'open target csv file if not already opened
    If CheckFileIsOpen("test.csv") = False Then
        Set myData = Workbooks.Open(strFilePath & "test.csv")
    Else
        Set myData = Workbooks("test.csv")
    End If

    Set shtPaste = myData.Sheets("test")
    shtPaste.UsedRange.Clear

    With wb.Sheets("Report Group")

        LR = .Range("A" & .Rows.Count).End(xlUp).Row

        If LR > 1 Then
            MyCopyRange = Array("A4:A" & LR, "B4:B" & LR, "C4:C" & LR, "D4:D" & LR)
            'Loop the array copying and pasting based on element in the array
            For X = LBound(MyCopyRange) To UBound(MyCopyRange)
                .Range(MyCopyRange(X)).Copy
                shtPaste.Range(MyPasteRange(X)).PasteSpecial _
                           xlPasteValuesAndNumberFormats 'xlPasteValues
            Next
        Else
            shtPaste.Range("A1") = "No Data Found"
        End If

    End With

End Sub

谢谢代码按预期工作,除了MyCopyRange将在我们获得LRMissed的值后执行-修复