Импорт и копирование вставки на другой лист - PullRequest
0 голосов
/ 21 мая 2019

Я написал код ниже, чтобы импортировать новые данные в мою книгу и еженедельно обновлять таблицу шаблонов.Я попробовал это на прошлой неделе, и он успешно импортировал мои новые данные и скопировал, вставил данные в шаблон таблицы на другом листе.На этой неделе, когда я запускал свой макрос, он работал только для ввода новых данных, но не копировал и вставлял новые данные в шаблон таблицы.Лично я не понимаю, почему это произошло, потому что нет сообщения об ошибке, хотя я закомментировал «дескриптор ошибки», он прекрасно работает только для импорта нового файла, но вторая функция этого кода не выполняется.

Может кто-нибудь просмотреть и отредактировать мой код, пожалуйста?Есть ли у вас какие-либо предложения написать другой код для копирования и вставки моих новых данных на другой лист (в данном случае внутри шаблона таблицы)?

Option Explicit

Sub Import_ClientClass()

 '1. First Import data 1-to-1 to Client Class Table template
    '2. Used Find function to find the matching header from Client Class in New Data
    '3. Copy and Paste the required column from New Data in Client Class    

    Dim lastrow As Long, LastTemp As Long 'lasttemp is "last row for table template
    Const StartRowTemp As Byte = 1
    Dim c As Byte 'number of columns
    Dim GetHeader As Range 'find

    Call Entry_Point
    On Error GoTo Handle

    'pick files to import - allow multiselect
    FiletoOpen = Application.GetOpenFilename _
    (FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select Workbook to Import", MultiSelect:=True)

    If IsArray(FiletoOpen) Then
        For FileCnt = 1 To UBound(FiletoOpen)
        Set SelectedBook = Workbooks.Open(Filename:=FiletoOpen(FileCnt))
        ShDataN.Cells.Clear
        SelectedBook.Worksheets("Client").Cells.Copy
        ShDataN.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        SelectedBook.Close

        'locate last empty row in Client Class Table
        lastrow = ShTrial.Cells(Rows.Count, 1).End(xlUp).Row + 1

        'locate last row in the new data
        LastTemp = ShDataN.Cells(Rows.Count, 1).End(xlUp).Row

        'use find function to match headers, since the template could have a different order of columns than the Client Rating Table

        c = 1
        Do While ShTrial.Cells(1, c) <> ""

        Set GetHeader = ShDataN.Rows(StartRowTemp).Find _
        (What:=ShTrial.Cells(1, c).Value, LookIn:=xlValues, MatchCase:=False, lookat:=xlWhole)
        If Not GetHeader Is Nothing Then

            ShDataN.Range(ShDataN.Cells(StartRowTemp + 1, GetHeader.Column), ShDataN.Cells(LastTemp, GetHeader.Column)).Copy
            ShTrial.Cells(lastrow, c).PasteSpecial

        End If 'get Header
        c = c + 1
       Loop

        Next FileCnt
        MsgBox "Data imported sucessfully", vbInformation, "General Information"

    End If 'isArray
    ShTrial.Select
    Range("A1").Select

    Call Exit_Point

    Exit Sub

Handle:
    If Err.Number = 9 Then
    Else
    MsgBox "An error has occured"
    End If

Call Exit_Point

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...