Импорт ежедневных файлов CSV в стандартные расположения Excel

Question

Я хочу импортировать CSV-файлы в мою собственную книгу. Теперь он создает новую книгу каждый раз. Я хочу, чтобы данные в моих CSV-файлах помещались на разных листах. Только я хочу, чтобы набор данных составлял 11 стандартных листов, потому что у меня 11 команд (команда A, команда B и т. Д.). В настоящее время это работает, поскольку создает новую рабочую книгу с 11 листами.

У меня настроен файл Excel, который я хочу использовать для проекта. В этом случае есть несколько команд, которые ежедневно экспортируют данные в CSV-файлы. Теперь я хочу импортировать эти файлы в свою активную книгу, где у каждой команды будет свой лист. Файлы данных CSV необходимо будет импортировать с помощью кнопки. Затем данные CSV будут помещены в ту же книгу.

Я нашел следующий код в сети, и он хорошо работает! Единственная проблема с этим способом состоит в том, что он создает новую рабочую книгу каждый раз. Затем мне нужно скопировать данные из новой сгенерированной рабочей книги (данные на группу в листах) в мою собственную рабочую книгу.

Эта вставка копии, как вы можете себе представить, сейчас довольно раздражает. Я надеюсь, что есть кто-то, кто хорош в программировании и может мне помочь :)? Код, который я сейчас использую для импорта данных в случайно сгенерированную книгу, выглядит следующим образом:

Sub DataImporteren()


    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = ","

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="CSV Files (*.csv), *.csv", _
      MultiSelect:=True, Title:="CSV Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=False, _
      Other:=True, OtherChar:="|"
    x = x + 1

    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=sDelimiter
        End With
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler

End Sub

Итак, в конце концов, что мне нужно помочь с: Стандартная рабочая тетрадь, где у меня есть мой обзор. С расчетами и формулами для сравнения импортируемых данных. (уже есть это работает)

Импортируйте данные в эту стандартную книгу вместо макроса, каждый раз создавая новую книгу.

Для каждой команды в (стандартные файлы csv) моей рабочей тетради есть стандартный лист. CSV-файл: «Team A» импортируется в рабочую таблицу Team A каждый раз, когда я импортирую новый обновленный CSV-файл Team A и т. Д.

Я надеюсь, что кто-то может мне помочь, так как это сэкономит мне много времени при копировании.

Answer 1

У меня работает следующее. В вопросе есть ряд изменений в коде.

• Целевая рабочая книга устанавливается в начале, перед открытием файлов, что приведет к изменению «активной» рабочей книги. Таким образом, нет путаницы.
• Все копирование выполняется в цикле For...Next. Насколько я могу сказать, нет причин для одного выполнения, а затем цикла. Я использовал For...Next, чтобы x увеличивался автоматически.
• Фактическая проблема, заданная в этом вопросе, связана с не указанием target , куда должно быть вставлено содержимое файла csv. Если целевой диапазон не указан, данные помещаются в новую рабочую книгу. Таким образом, целевой диапазон устанавливается на рабочий лист (x + 1) в целевой рабочей книге; UsedRange входящей таблицы данных копируется (вместо всей рабочей таблицы) - это помещает данные в верхнем левом углу целевой таблицы.
• x + 1 используется, поскольку данные должны идти ко второму и последующим рабочим листам.
• Таблица данных закрывается только после копирования и вставки, а для переменной задано значение Nothing. В моих тестах это работало более надежно.

В существующем виде Excel будет запрашивать, перезаписывать ли существующее содержимое листа при вводе новых данных. Если это не требуется, вставьте строку, которая удаляет UsedRange каждого рабочего листа перед вставкой данных.

Sub DataImporteren()
    Dim FilesToOpen
    Dim x As Long
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim wsData As Worksheet
    Dim rngDestination As Range
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"
    x = 1

    Set wkbAll = ActiveWorkbook
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="CSV Files (*.csv), *.csv", _
      MultiSelect:=True, Title:="CSV Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    For x = 1 To UBound(FilesToOpen)
        'Start at second worksheet
        Set rngDestination = wkbAll.Worksheets(x + 1).Range("A1")
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        Set wsData = wkbTemp.Worksheets(1)
        wsData.UsedRange.Copy rngDestination

        wkbAll.Worksheets(x + 1).Columns("A:A").TextToColumns _
          Destination:=Range("A1"), DataType:=xlDelimited, _
          TextQualifier:=xlDoubleQuote, _
          ConsecutiveDelimiter:=False, _
          Tab:=False, Semicolon:=False, _
          Comma:=False, Space:=False, _
          Other:=True, OtherChar:=sDelimiter

        wkbTemp.Close False
        Set wkbTemp = Nothing
    Next

ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler

End Sub