VBAmacros来操作文件夹中的所有工作簿

尝试创build一个VBAmacros以打开某个文件夹中的所有工作簿和工作表，然后将信息复制并粘贴到目标工作表中。

当我运行我的macros时，它给了我在targetWorkbook上的错误91。

你能帮我吗？

见下面的代码：

Sub importTransData() Dim directory As String, fileName As String, sheet As Worksheet, total As Integer Application.ScreenUpdating = False Application.DisplayAlerts = False Dim targetWorkbook As Workbook targetWorkbook = ActiveWorkbook.Name 'Choose directory directory = "C:\Users\midijk\Desktop\Testsource\" fileName = Dir(directory & "*.xl??") Do While fileName <> "" Workbooks.Open (directory & fileName) For Each sheet In Workbooks(fileName).Worksheets Dim sourceSheet As Worksheet Dim sourceWorkbook As Workbook sourceSheet = ActiveSheet.Name sourceWorkbook = ActiveWorkbook.Name 'Select A2:F2 Range("A2:F2").Select 'Select everything below Range(Selection, Selection.End(xlDown)).Select 'Copy Selection.Copy 'Select targetWorkbook Workbooks(targetWorkbook).Activate 'select targetsheet Sheets("Transactional Data").Select 'select A1 & go down Range("A1").End(xlDown).Offset(1).Select 'Paste as values Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'go back to source workbook Workbooks(sourceWorkbook).Activate 'go back to source sheet Sheets(sourceSheet).Select Next sheet Workbooks(fileName).Close fileName = Dir() Loop Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub 

Answer 1

好吧，我find了我的解决scheme！

 Sub importTransData() Dim directory As String, fileName As String, sheet As Worksheet, total As Integer Application.ScreenUpdating = False Application.DisplayAlerts = False Dim targetWorkbook As Workbook Set targetWorkbook = ThisWorkbook 'Choose directory directory = "C:\Users\midijk\Desktop\Testsource\" fileName = Dir(directory & "*.xl??") Do While fileName <> "" Workbooks.Open (directory & fileName) For Each sheet In Workbooks(fileName).Worksheets Dim sourceWorkbook As Workbook Dim sourceSheet As Worksheet Set sourceSheet = ActiveSheet Set sourceWorkbook = ActiveWorkbook 'Select A2:F2 Range("A2:F2").Select 'Select everything below Range(Selection, Selection.End(xlDown)).Select 'Copy Selection.Copy 'Select targetWorkbook targetWorkbook.Activate 'select targetsheet Sheets("Transactional Data").Select 'select A1 & go down Range("A1").End(xlDown).Offset(1).Select 'Paste as values Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'go back to source workbook sourceWorkbook.Activate 'go back to source sheet sourceSheet.Select Next sheet Workbooks(fileName).Close fileName = Dir() Loop Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub