2016-03-18 6 views
0

を統合されます。これは私が達成しようとしているものです:は同じシートと1つのワークブックに複数のワークブックで複数のシートを統合したが、複数のシート内のデータは、私がウェブ上このを探してみましたが、私の目的のために、私は必要なコードを最適化するために、これまでできなかった

私はエクセル1と呼ばれるファイルを、エクセル2、エクセル3とマスターExcelを持っています。すべてのファイルは、ヘッダーなどの場合、ワークシートの数、ワークシート名、および同じ構造を持ちます。

私は、マスターファイルにエクセル1、エクセル2およびExcel 3の値を統合しようとしています。

したがって、マスターファイルで1000という名前のシートがある場合は、1000という名前のExcel 1シートから範囲をコピーしてコピーします。次にExcel 2000でシート1000を探し、最後に空白行に範囲を貼り付けますマスターファイルシート1000

範囲で使用される行は、常に特定の列上のデータと最後の行までのヘッダの後行(これはすべてのシートに固定されている)です。

各ワークブックに複数のシートがあり、すべてのワークシートが同じ名前になります。

またファイルのファイルパスはので、私はから選択するオプションをたくない定数になります。

以下のコードは、ワークシートをループすることができ、コピーの貼り付け範囲を完全に定義することもできますが、対象シートとシート1000のデータを意味する対象シートとのマッチング方法はわかりませんマスターファイル内のシート1000に貼り付ける1つのファイルよりも優れています。

Sub test() 

Dim MyFile As String, MyFiles As String, FilePath As String 
Dim erow As Long 
'~~> Put additional variable declaration 
Dim wbMaster As Workbook, wbTemp As Workbook 
Dim wsMaster As Worksheet, wsTemp As Worksheet 

FilePath = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\" 
MyFiles = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\*.xlsx" 
MyFile = Dir(MyFiles) 

With Application 
    .ScreenUpdating = False 
    .DisplayAlerts = False 
End With 

'~~> Set your declared variables 
Set wbMaster = ThisWorkbook 'if you want to consolidate files in this workbook 
Set wsMaster = wbMaster.Sheets("Sheet1") 'replace Sheet1 to suit 

Do While Len(MyFile) > 0 
    'Debug.Print MyFile 
    If MyFile <> "master.xlsm" Then 
     '~~> Open the file and at the same time, set your variable 
     Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True) 
     Set wsTemp = wbTemp.Sheets(1) 'I used index, you said there is only 1 sheet 
     '~~> Now directly work on your object 
     With wsMaster 
      erow = .Range("A" & .Rows.Count).End(xlUp).Row 'get the last row 
      '~~> Copy from the file you opened 
      wsTemp.Range("A2:S20").Copy 'you said this is fixed as well 
      '~~> Paste on your master sheet 
      .Range("A" & erow).Offset(1, 0).PasteSpecial xlPasteValues 
     End With 
     '~~> Close the opened file 
     wbTemp.Close False 'set to false, because we opened it as read-only 
     Set wsTemp = Nothing 
     Set wbTemp = Nothing 
    End If 
    '~~> Load the new file 
    MyFile = Dir 
Loop 

With Application 
    .ScreenUpdating = True 
    .DisplayAlerts = True 
End With 

End Sub 
+0

は、あなたのマスターでのシート名と相関し、あなたのファイルパスで一時ワークブックの名前ている間に?私はあなたのドゥでいくつかの小さな変更をしましたか – mongoose36

+0

いいえ、そうではありません。彼らはランダムな名前です。ただし、ワークシートは各ワークブックで全く同じ名前が付けられています。 –

答えて

0

(コードで私のコメントを参照)、これを試してみてください、しかし、ループ

Sub test() 

Dim MyFile As String, MyFiles As String, FilePath As String 
Dim erow As Long 
'~~> Put additional variable declaration 
Dim wbMaster As Workbook, wbTemp As Workbook 
Dim wsMaster As Worksheet, wsTemp As Worksheet 
Dim i As Integer 

FilePath = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\" 
MyFiles = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\*.xlsx" 
MyFile = Dir(MyFiles) 

With Application 
    .ScreenUpdating = False 
    .DisplayAlerts = False 
End With 

'~~> Set your declared variables 
Set wbMaster = ThisWorkbook 'if you want to consolidate files in this workbook 

Do While Len(MyFile) > 0 
    'Debug.Print MyFile 
    If MyFile <> "master.xlsm" Then 
     '~~> Open the file and at the same time, set your variable 
     Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True) 
     'Start the loop of sheets within the source workbook 
     For i = 1 To wbTemp.Sheets.Count 
      Set wsTemp = wbTemp.Sheets(i) 'I used index, you said there is only 1 sheet 
      '~~> Now directly work on your object 
      With wbMaster.Worksheets(wsTemp.Name) 'This matches the sheet name in the source workbook to the sheet name in the target workbook 
       erow = .Range("A" & .Rows.Count).End(xlUp).Row 'get the last row of target sheet 
       '~~> Copy from the file you opened 
       wsTemp.Range("A2:S20").Copy 'you said this is fixed as well 
       '~~> Paste on your master sheet 
       .Range("A" & erow).Offset(1, 0).PasteSpecial xlPasteValues 
       Application.CutCopyMode = False 
      End With 
     Next i 
     '~~> Close the opened file 
     wbTemp.Close False 'set to false, because we opened it as read-only 
    End If 
    '~~> Load the new file 
    MyFile = Dir 
Loop 

With Application 
    .ScreenUpdating = True 
    .DisplayAlerts = True 
End With 

End Sub 
+0

ありがとう。私が欲した方法で正確に働いた:) –

0

wbMasterでシート名を取り、wbTempで同じ名前のシートを参照するには、変数に名前を渡すことができます。ここで

Dim strSheetname as String 

For i = 1 To wbMaster.Sheets.Count 
     strSheetName = wbMaster.Sheets(i).Name 
     Set wsTemp = wbTemp.Sheets(strSheetName) 
     'Do whatever you need here with wsTemp 
Next i 

このコードは、エラー処理をwbMasterであなたのシートをループ欠けます数行がある(シートがwbTempに存在しないことwbMasterに存在する場合、すなわち、あなたは範囲エラーのうちを取得します)しかし、これはあなたを始めさせるでしょう。

関連する問題