Блог

У меня есть код, который создает книгу путем копирования и перемещения выбранных листов в новую книгу. Первая страница этой новой книги-это страница с кратким изложением. В связи с этим я хочу извлечь данные из последующих листов с помощью метода range.value. Однако могу ли я использовать это при ссылке, например, на расположение листа

 Dim wb As Workbook, wbAll As Workbook Dim ws As Worksheet  Set wbAll = Workbooks.Add On Error Resume Next For t = 1 To 100   Set wb = Workbooks("Book" amp; t)  For Each ws In wb.Sheets  ws.Move after:=wbAll.Sheets(Sheets.Count)  Next Next Workbooks("Book" amp; t).Activate ActiveWorkbook.Sheets("Sheet1").Select  'compile worksheets into list Dim wss As Worksheet Dim x As Integer  On Error Resume Next   x = 17   Sheets("Sheet1").Range("c17:E46").ClearContents    For Each wss In ActiveWorkbook.Worksheets  If wss.Name lt;gt; "Sheet1" Then  Sheets("Sheet1").Cells(x, 3) = wss.Name  x = x   1  End If Next wss  'COMPILE COSTS ActiveWorkbook.Sheet1.Range("C17").Value = ActiveWorkbook.Worksheet(2).Range("Q118").Value ActiveWorkbook.Sheet1.Range("C18").Value = ActiveWorkbook.Worksheet(3).Range("Q118").Value . . ActiveWorkbook.Sheet1.Range("C45").Value = ActiveWorkbook.Worksheet(30).Range("Q118").Value ActiveWorkbook.Sheet1.Range("C46").Value = ActiveWorkbook.Worksheet(31).Range("Q118").Value  'Compile WBS ActiveWorkbook.Sheet1.Range("D17").Value = ActiveWorkbook.Worksheet(2).Range("D10").Value ActiveWorkbook.Sheet1.Range("D18").Value = ActiveWorkbook.Worksheet(3).Range("D10").Value . . ActiveWorkbook.Sheet1.Range("D45").Value = ActiveWorkbook.Worksheet(30).Range("D10").Value ActiveWorkbook.Sheet1.Range("D46").Value = ActiveWorkbook.Worksheet(31).Range("D10").Value   'Week Number name ActiveWorkbook.Sheet1.Range("C10").Value = ActiveWorkbook.Worksheet(2).Range("D4").Value 'Supplier Name ActiveWorkbook.Sheet1.Range("C12").Value = ActiveWorkbook.Worksheet(2).Range("D5").Value  

Это, однако, выдает мне сообщение об ошибке, содержащее ошибку, определенную объектом

Это может помочь:

ИЗМЕНИТЬ: обновлено для отображения с использованием ссылок вместо копирования значений с листа.

 Sub Tester()    Dim wb As Workbook, wbAll As Workbook  Dim ws As Worksheet  Dim wss As Worksheet  Dim x As Integer, wsSummary, t As Long    Set wbAll = Workbooks.Add    For t = 1 To 100  Set wb = Nothing  On Error Resume Next 'ignore any error  Set wb = Workbooks("Book" amp; t)  On Error GoTo 0 'cancel OERN as soon as possible  If Not wb Is Nothing Then  For Each ws In wb.Sheets  ws.Move after:=wbAll.Sheets(wbAll.Sheets.Count)  Next  End If  Next  'Workbooks("Book" amp; t).Activate 'not sure what this is for?  'ActiveWorkbook.Sheets("Sheet1").Select    'compile worksheets into list  x = 17  Set wsSummary = wbAll.Sheets("Sheet1")  wsSummary.Range("C17:E46").ClearContents    For Each wss In wbAll.Worksheets  If wss.Name lt;gt; wsSummary.Name Then  With wsSummary.Rows(x)  '.Cells(3).Value = wss.Name  InsertLink .Cells(5), wss.Range("A1"), "=SheetName({1})"  '.Cells(4).Value = wss.Range("Q118").Value  InsertLink .Cells(4), wss.Range("Q118") 'create a link  '.Cells(5).Value = wss.Range("D10").Value  InsertLink .Cells(5), wss.Range("D10")  'etc etc  End With  x = x   1  End If  Next wss  End Sub 'UDF to return the sheet name Function SheetName(c As Range)  Application.Volatile  SheetName = c.Parent.Name End Function  'Insert a worksheet formula into a cell (rngDest), where the precedents ' are either a single cell/range or an array of cells/ranges (SourceRange) ' sTemplate is an optional string template for the formula ' eg. "=SUM({1},{2})" where {1} and {2} are ranges in SourceRange ' Empty template defaults to "={1}" 'Useage: ' InsertLink sht1.Range("A1"), Array(sht1.Range("B1"), sht1.Range("C1")), "=SUM({1},{2})" Sub InsertLink(rngDest As Range, SourceRange As Variant, Optional sTemplate As String)  Dim i As Long, sAddress As String, arrTmp As Variant    If sTemplate = "" Then sTemplate = "={1}" 'default is a simple linking formula    'got a single range, or an array of ranges?  If TypeName(SourceRange) = "Range" Then  arrTmp = Array(SourceRange) 'make an array from the single range  Else  arrTmp = SourceRange 'use as-is  End If  'loop over the input range(s) and build the formula  For i = LBound(arrTmp) To UBound(arrTmp)  sAddress = ""  If rngDest.Parent.Name lt;gt; arrTmp(i).Parent.Name Then  sAddress = "'" amp; arrTmp(i).Parent.Name amp; "'!"  End If  sAddress = sAddress amp; arrTmp(i).Address(False, False)  sTemplate = Replace(sTemplate, "{" amp; CStr(i   1) amp; "}", sAddress)  Next i  rngDest.Formula = sTemplate 'assign the formula  End Sub