Excel VBA, если файл закрыт, затем открыть и вставить, иначе просто вставьте данные - PullRequest
Новая
       9

Excel VBA, если файл закрыт, затем открыть и вставить, иначе просто вставьте данные

0 голосов
/ 11 сентября 2018

У меня есть макросы 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

1 Ответ

0 голосов
/ 11 сентября 2018

Немного переработан, чтобы добавить полную классификацию книг / листов и избежать активации / выбора 

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
...