VBAマクロを使用してフォルダ内のすべてのブックを操作する

Question

VBAマクロを作成して、特定のフォルダ内のすべてのブックとシートを開き、コピーして対象シートに貼り付けます。

マクロを実行すると、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

よし、みんな！

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