我有一个代码,可将许多公司文件中的数据编译为一个大文件。某些文件的FirstRow值为空白,因此它会提取标题和空白单元格。相反,如果FirstRow为空,我想使用If语句跳过文件。这是当前的代码:
Dim Summary As Worksheet
Dim FolderPath As String
Dim SelectedFiles() As Variant
Dim nrow As Long
Dim FileName As String
Dim nfile As Long
Dim wb As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim LastRow As Long
Dim FirstRow As Long
'Set Summary as the current excel file in which the macro will run
Set Summary = ActiveWorkbook.Sheets(1)
'Modify this folder path to point to the folder that contains copies of the commission statements
FolderPath = "C:\Users\stroychak\Dropbox (Apttus)\Commission Folder\000 Commission Statements\z - All Commissions\Commission Summary VBA - statements"
'Set the current directory and drive to the desired folder path
ChDrive FolderPath
ChDir FolderPath
'Open the file dialogue box to select the commission statements to be compiled; allow for multiple statements to be selected at once
SelectedFiles = Application.GetOpenFilename(MultiSelect:=True)
'nrow keeps track of where to insert new rows in the destination workbook
nrow = 1
For nfile = LBound(SelectedFiles) To UBound(SelectedFiles)
FileName = SelectedFiles(nfile)
Set wb = Workbooks.Open(FileName)
LastRow = wb.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
FirstRow = wb.Worksheets(1).Cells.Find("Opportunity Name").Row + 1
Set SourceRange = wb.Worksheets(1).Range("A" & FirstRow & ":AB" & LastRow)
Set DestRange = Sheet1.Range("A" & nrow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
DestRange.Value = SourceRange.Value
nrow = DestRange.Rows.Count + nrow
wb.Close savechanges = False
Next nfile
ActiveSheet.Columns.AutoFit
MsgBox "Compilation is complete"
End Sub
答案 0 :(得分:0)
这对您有何作用?
Dim Summary As Worksheet
Dim FolderPath As String
Dim SelectedFiles() As Variant
Dim nrow As Long
Dim FileName As String
Dim nfile As Long
Dim wb As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim LastRow As Long
Dim FirstRow As Long
'Set Summary as the current excel file in which the macro will run
Set Summary = ActiveWorkbook.Sheets(1)
'Modify this folder path to point to the folder that contains copies of the commission statements
FolderPath = "C:\Users\stroychak\Dropbox (Apttus)\Commission Folder\000 Commission Statements\z - All Commissions\Commission Summary VBA - statements"
'Set the current directory and drive to the desired folder path
ChDrive FolderPath
ChDir FolderPath
'Open the file dialogue box to select the commission statements to be compiled; allow for multiple statements to be selected at once
SelectedFiles = Application.GetOpenFilename(MultiSelect:=True)
'nrow keeps track of where to insert new rows in the destination workbook
nrow = 1
For nfile = LBound(SelectedFiles) To UBound(SelectedFiles)
FirstRow = 0 'Set this, if you forget you will have mixed results
FileName = SelectedFiles(nfile)
Set wb = Workbooks.Open(FileName)
LastRow = wb.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
On Error Resume Next 'If it fails FirstRow remains 0
FirstRow = wb.Worksheets(1).Cells.Find("Opportunity Name").Row + 1
If FirstRow <> 0 Then
'Found it
Set SourceRange = wb.Worksheets(1).Range("A" & FirstRow & ":AB" & LastRow)
Set DestRange = Sheet1.Range("A" & nrow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
DestRange.Value = SourceRange.Value
nrow = DestRange.Rows.Count + nrow
Else 'Do Nothing, Didn't find it
End If
wb.Close savechanges = False
Next nfile
ActiveSheet.Columns.AutoFit
MsgBox "Compilation is complete"
End Sub