Я написал код ниже, чтобы импортировать новые данные в мою книгу и еженедельно обновлять таблицу шаблонов.Я попробовал это на прошлой неделе, и он успешно импортировал мои новые данные и скопировал, вставил данные в шаблон таблицы на другом листе.На этой неделе, когда я запускал свой макрос, он работал только для ввода новых данных, но не копировал и вставлял новые данные в шаблон таблицы.Лично я не понимаю, почему это произошло, потому что нет сообщения об ошибке, хотя я закомментировал «дескриптор ошибки», он прекрасно работает только для импорта нового файла, но вторая функция этого кода не выполняется.
Может кто-нибудь просмотреть и отредактировать мой код, пожалуйста?Есть ли у вас какие-либо предложения написать другой код для копирования и вставки моих новых данных на другой лист (в данном случае внутри шаблона таблицы)?
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