如何将一个工作表中的命名区域的值分配给活动工作表中的单元格?

时间:2015-05-29 19:16:18

标签: excel vba excel-vba

我正在尝试将名为BOD_Labsheet的格式化工作表中的数据存档到一个名为Data的数据。我使用UserForms做了类似的事情但是在这里遇到了问题。

当我运行宏时,我收到错误" Method' Range'对象_Worksheet失败"在线

dataWorksheet.Cells(emptyRow, 2) = bodWorksheet.Range("BOD_Lab_Date").Value

执行复制时,数据工作表处于活动状态。

我应该简单地将BOD_Labsheet中的所有值复制到数组中,激活数据工作表和重新复制值吗?

以下是完整的代码:

    Sub Submit_BOD()
'
' Submit_BOD Macro
'
Dim dataWorksheet As Worksheet, bodWorksheet As Worksheet, suspendedSolidsWorksheet As Worksheet
Dim dataSheetName As String
Dim bodSheetName As String
Dim suspendedSolidsName As String

dataSheetName = "Data"
bodSheetName = "BOD_Labsheet"
suspendedSolidsName = "Suspended_Solids_Labsheet"

Set dataWorksheet = ActiveWorkbook.Sheets(dataSheetName)
Set bodWorksheet = ActiveWorkbook.Sheets(bodSheetName)
Set suspendedSolidsWorksheet = ActiveWorkbook.Sheets(suspendedSolidsName)

Dim myRanges() As Variant
myRanges = Array("BOD_Collected_By", "BOD_Temp_Out", "BOD_Temp_IN", "BOD_Source", "BOD_Sample_Vol_4", _
                "BOD_Dilution_1", "BOD_Blank_IDO_4", "BOD_Blank_FDO_4", "BOD_Sample_Vol_7", "BOD_Dilution_2", _
                "BOD_Blank_IDO_7", "BOD_Blank_FDO_7", "BOD_Seed_IDO_13", "BOD_Seed_FDO_13", "BOD_Seed_IDO_14", _
                "BOD_Seed_FDO_14", "BOD_Influent_IDO_15", "BOD_Influent_FDO_15", "BOD_Influent_IDO_16", _
                "BOD_Influent_FDO_16", "BOD_Effluent_IDO_20", "BOD_Effluent_FDO_20", "BOD_Effluent_IDO_21", "BOD_Effluent_FDO_21", _
                "In_BOD_Concentration", "Out_BOD_Concentration")

'Make Data Sheet active
dataWorksheet.Activate

Dim myDate As Date
myDate = DateValue(bodWorksheet.Range("BOD_Lab_Date").Value)


Dim yearAsString As String, monthAsString As String, dayAsString As String
yearAsString = Format(myDate, "yyyy")
monthAsString = Format(myDate, "mm")
dayAsString = Format(myDate, "dd")

Dim reportNumberText As String
reportNumberText = "NP" & yearAsString & monthAsString & dayAsString
Debug.Print "reportNumberText = "; reportNumberText

'Determine emptyRow
Dim emptyRow As Integer
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Transfer information
'Sample Number
dataWorksheet.Cells(emptyRow, 1).Value = reportNumberText

'Date and Time Collected

dataWorksheet.Cells(emptyRow, 2) = bodWorksheet.Range("BOD_Lab_Date").Value
dataWorksheet.Cells(emptyRow, 3) = Format(bodWorksheet.Range("BOD_Collection_Date").Value, "dd-mmm-yyyy")
dataWorksheet.Cells(emptyRow, 4) = Format(bodWorksheet.Range("BOD_Read_On_Date").Value, "dd-mmm-yyyy")

Dim i As Integer, j As Integer

For i = LBound(myRanges) To UBound(myRanges)
j = i + 4
dataWorksheet.Cells(emptyRow, j) = bodWorksheet.Range(myRanges(i)).Value
Debug.Print "dataWorksheet.Cells(" & emptyRow & "," & j & ") " & dataWorksheet.Cells(emptyRow, j).Value

Next i

ActiveWorkbook.Save

suspendedSolidsWorksheet.Activate
Range("SS_Date").Select

End Sub

1 个答案:

答案 0 :(得分:0)

" BOD_LAB_DATE"不止一个细胞?也许你的方法通常也有效,但我通常会通过颠倒你的订单并使用副本来复制一系列单元格,如下所示:

bodWorksheet.Range("BOD_Lab_Date").Copy dataWorksheet.Cells(emptyRow, 2)