0
好吧,我有幾個獨立的excel文件需要合併到一個excel文件中。我有代碼來做到這一點,並添加一個標題行進行排序。問題是如果我點擊取消導入它將我帶到調試屏幕。如果用戶點擊取消,我希望它結束該功能。我已經嘗試了幾種不同的方法,但仍然與我已經註釋過的IF不匹配。以下是我在網上找到的代碼的修改。任何幫助正確的方向將不勝感激。先謝謝你。GetOpenFilename VBA的錯誤或取消處理程序
Sub MergeAllWorkbooks()
Call MergeFMDataSelect
Call AddHeaders
End Sub
Sub MergeFMDataSelect()
Dim SummarySheet As Worksheet, WorkBk As Workbook
Dim SelectedFiles() As Variant
Dim FileName As String, FolderPath As String
Dim NFile As Long, LastRow As Long, NRow As Long
Dim SourceRange As Range, DestRange As Range
Application.ScreenUpdating = False
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
'Set SummarySheet = Worksheets("FMData")
' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\Desktop"
' Set the current directory to the the folder path.
ChDrive FolderPath
'ChDir FolderPath
' Open the file dialog box and filter on Excel files, allowing multiple files
' to be selected.
SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
'If SelectedFiles = Cancel Then
'MsgBox "File not selected to import. Process Terminated"
'Exit Sub
'End If**
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Loop through the list of returned file names
For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
' Set FileName to be the current workbook file name to open.
FileName = SelectedFiles(NFile)
' Open the current workbook.
Set WorkBk = Workbooks.Open(FileName)
' Set the cell in column A to be the file name.
'SummarySheet.Range("A" & NRow).Value = FileName
' Set the source range
LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", After:=WorkBk.Worksheets(1).Cells.Range("A1"), SearchDirection:=xlPrevious, LookIn:=xlFormulas, SearchOrder:=xlByRows).Row
Set SourceRange = WorkBk.Worksheets(1).Range("A2:BA" & LastRow)
' Set the destination range to start at column a and be the same size as the source range.
Set DestRange = SummarySheet.Range("A" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
Next NFile
Application.ScreenUpdating = True
' Call AutoFit on the destination sheet so that all data is readable.
' SummarySheet.Columns.AutoFit
End Sub
Sub AddHeaders()
Dim headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Application.ScreenUpdating = False 'turn this off for the macro to run a little faster
Set wb = ActiveWorkbook
headers() = Array("OBJECTID", "cfeedernum", "clinenum", "cpolenum", "ctaxdist", "clocation", "cregion", "copdist", "czone")
Range("A1").EntireRow.Insert
For Each ws In wb.Sheets
With ws
'.Rows(1).Value = "" 'This will clear out row 1
For i = LBound(headers()) To UBound(headers())
.Cells(1, 1 + i).Value = headers(i)
Next i
.Rows(1).Font.Bold = True
End With
Next ws
Application.ScreenUpdating = True 'turn it back on
MsgBox ("Done!")
End Sub
此答案已被「拒絕」;解釋將不勝感激。 – Excelosaurus