我是全新的,这是我的第一个脚本。因此,在此先感谢您提供的任何帮助。
再过几天,我将收到我公司200多家分支机构的一系列调查。调查数据是在单个excel电子表格中收集的。
我正在尝试修改从Microsoft网站获得的脚本,该脚本遍历所有电子表格并将数据编译为单个电子表格。
我得到的错误是:编译错误:属性的无效使用
这是我的代码:
Sub MergeGTISurvey()
Dim SurveySummary As Worksheet
Set SurveySummary = Workbooks.Add(xlWBATWorksheet).Worksheets
Dim FolderPath As String
FolderPath = "C:\Users\dloots\mycompany\testsurveyfolder\"
Dim NRow As Long
NRow = 1
Dim Filename As String
Filename = Dir(FolderPath & "*.xl*")
Do While Filename <> ""
Dim WorkBk As Workbook
Set WorkBk = Workbooks.Open(FolderPath & Filename)
SurveySummary.Range("A" & NRow).Value = Filename
Dim Sheet As Worksheets
Set Worksheets = Sheet
Dim SourceRange As Range
Set SourceRange = WorkBk.Worksheets("Network").Range("B4:B16").Select
Dim DestRange As Range
Set DestRange = SurveySummary.Range("B" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
DestRange.Value = SourceRange.Value
NRow = NRow + DestRange.Rows.Count
WorkBk.Close savechanges:=False
Filename = Dir()
Loop
最佳答案
这是您代码的修改版本。您可以尝试一下。
您可能仍需要修改某些范围
Sub MergeGTISurvey()
Dim SurveySummary As Workbook
Set SurveySummary = Workbooks.Add(xlWBATWorksheet)
Dim SurveySummarySheet As Worksheet
Set SurveySummarySheet = SurveySummary.ActiveSheet
Dim FolderPath As String
FolderPath = "C:\Users\dloots\mycompany\testsurveyfolder\"
Dim NRow As Long
NRow = 1
Dim Filename As String
Filename = Dir(FolderPath & "*.xl*")
Do While Filename <> ""
Dim WorkBk As Workbook
Set WorkBk = Workbooks.Open(FolderPath & Filename)
SurveySummarySheet.Range("A" & NRow).Value = Filename
Dim Worksht As Worksheet
Set Worksht = WorkBk.Worksheets("Network")
Worksht.Range("B4:B16").Copy
SurveySummarySheet.Range("B" & CStr(NRow)).PasteSpecial
' This will get last row after paste
NRow = SurveySummarySheet.Cells.SpecialCells(xlLastCell).Row + 1
WorkBk.Close savechanges:=False
Filename = Dir()
Loop
End Sub
关于excel - VBA Excel-编译错误-属性无效使用,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/25430306/