2017-02-06 6 views
2

私は以下のコードを持っています。Excel - ワークブックで名前を指定

非常に単純に、ユーザーに複数のExcelワークブックを選択し、それらのワークブックのデータをコピーして現在のワークブックに貼り付けるように求めます。

1. ユーザーがExcelワークブックを選択する代わりに、この機能を追加したいと考えています。 Excelブックは、その名前が現在のExcelシートに記載されているため、選択されます。

例:A1:A5に名前がリストされている特定のフォルダ内のExcelブックを選択します。

  1. データを現在のワークブックにコピーする前に自動処理を実行したいと思います。たとえば、

ワークブック名​​は= 100.xlsxその後、これは微調整が必​​要なフレームですが、あなたが得ることができる私の現在のコード

Sub SUM_BalanceSheet() 

Application.ScreenUpdating = False 

'FileNames is array of file names, file is for loop, wb is for the open file within loop 
'PasteSheet is the sheet where we'll paste all this information 
'lastCol will find the last column of PasteSheet, where we want to paste our values 
Dim FileNames 
Dim file 
Dim wb As Workbook 
Dim PasteSheet As Worksheet 
Dim lastCol As Long 

Set PasteSheet = ActiveSheet 
lastCol = PasteSheet.Cells(1, Columns.Count).End(xlToLeft).Column 

'Build the array of FileNames to pull data from 
FileNames = Application.GetOpenFilename(filefilter:="Excel Files (*.xlsx), *.xlsx", MultiSelect:=True) 
'If user clicks cancel, exit sub rather than throw an error 
If Not IsArray(FileNames) Then Exit Sub 

'Loop through selected files, put file name in row 1, paste P18:P22 as values 
'below each file's filename. Paste in successive columns 
For Each file In FileNames 
    Set wb = Workbooks.Open(file, UpdateLinks:=0) 
    PasteSheet.Cells(1, lastCol + 1) = wb.Name 
    wb.Sheets("Page 1").Range("L14:L98").Copy 
    PasteSheet.Cells(2, lastCol + 1).PasteSpecial Paste:=xlPasteValues 
    wb.Close SaveChanges:=False 
    lastCol = lastCol + 1 
Next 

'If it was a blank sheet then data will start pasting in column B, and we don't 
'want a blank column A, so delete it if it's blank 
If Cells(1, 1) = "" Then Cells(1, 1).EntireColumn.Delete shift:=xlLeft 

Application.CutCopyMode = False 
Application.ScreenUpdating = True 

End Sub 

答えて

0

を見る15.

によって選択を掛けた場合アイデア:

Dim i&, wbName$ 
Dim rng As Excel.Range 
Dim wb, wb1 As Excel.Workbook 

Set wb = Application.ThisWorkbook 
Set rng = wb.Sheets("Sheet1").Range("A1") 
For i = 0 To 14 
    wbName = CStr(rng.Offset(i, 0).Value) 
    On Error Resume Next 'Disable error handling. We will check whether wb is nothing later 
    wb1 = Application.Workbooks.Open(wbName, False) 
    On Error GoTo ErrorHandler 
    If Not IsNothing(wb1) Then 
     'Copy-paste here 
     If wb1.Name = "100" Then 'any condition(s) 
      'Multiply, divide, or whatever 
     End If 
    End If 
Next 


ErrorHandler: 
    MsgBox "Error " & Err.Description 
    'Add additional error handling 

は絶対必要なく、ActiveSheetActiveWorkbookを使用しないようにしてください。 ThisWorkbook、専用Workbookオブジェクト、代わりにWorkbook.Sheets("Name")またはWorkbook.Sheets(index)という名前のシートを使用してください。

また、エラーチェックを無効にする代わりに、エラーチェックを行うこともできます。ファイルが見つからない場合は失敗します。

+0

ありがとう、ユージーン、どのように私は範囲を倍増するだろうか? – RalphDylan

+0

@RalphDylanターゲット範囲内の各セルを反復し、新しい値 'rng.Value = rng.Value * Factor'を割り当てることができます。または、ある一時的なセルに因子を入れることもできます(' Set rngFactor = SomeSheet.Cells(1,1).Value')、それをコピーし、乗算の値としてターゲット範囲に挿入する: 'rngTarget.PasteSpecial Paste:= xlPasteValues、Operation:= xlMultiply、SkipBlanks:= False、Transpose := False' – Eugene

関連する問題