2016-09-16 135 views
1

我有一个电子表格,每天刷新数据。我想将数据复制并粘贴到档案表中。我设法通过选择特定范围的细胞来实现这一点,但问题在于细胞的范围每天都会改变。复制并粘贴每次刷新数据时范围发生变化的单元格范围

Sub Archive_Data() 

Dim mainworkbook As Workbook 
Set mainworkbook = ActiveWorkbook 
mainworkbook.Sheets("Status Report (Execution)").Range("B17:AB56").Copy 
mainworkbook.Sheets("Archive Execution").Paste 

End Sub 

此代码选择所有的数据并粘贴它,但它不是我正在寻找的。

+2

帮助我们来帮助你。 **发布你的当前代码**。 –

+0

什么导致单元格范围发生变化? –

+0

子Archive_Data() 昏暗mainworkbook作为工作簿 设置mainworkbook = ActiveWorkbook mainworkbook.Sheets( “状态报告(执行)”)范围。( “B17:AB56”)复制 mainworkbook.Sheets( “存档执行”) .Paste End Sub –

回答

0

您可以使用命名范围。 (突出显示单元格区域,右键单击,定义名称...)如果在范围内添加了行或列,范围边界将自动更新。 然后,在你的代码,

Dim rangeName 
rangeName = "Status Report" 'Or whatever name you gave the range.    
Application.Goto Reference:=rangeName 'This will also select the range of cells. 
selection.Copy 
mainworkbook.Sheets("Archive Execution").Paste 

您还可以,如果你想要把复制的单元格中的特定位置的目标页面上创建目的地的命名范围。这里有一些子程序可以帮助你。

Public Sub test() 
    Call Copy_Detail_Rows("Sheet1", "Sheet2", "Status_Report") 
End Sub 

Private Sub Copy_Detail_Rows(sourceWorksheet, targetWorksheet, rangeName) 
    ' 
    ' Copy_Detail_Rows Macro 
    ' Copy the detail rows using rangeName from the source worksheet to the target worksheet. 
    ' See Formulas tab, Name Manager to manage named ranges. 
    ' 
     'First, check to ensure that the source and target worksheets exist. 
     On Error GoTo SourceWorksheetErrorHandler 
      Sheets(sourceWorksheet).Select 'Go to the source worksheet. 
     On Error GoTo 0 'Reset default error handling. 

     On Error GoTo TargetWorksheetErrorHandler 
      Sheets(targetWorksheet).Select 'Go to the target worksheet. 
     On Error GoTo 0 'Reset default error handling. 

     'Delete any existing data in the target range. 
     On Error GoTo TargetReferenceErrorHandler 
      Application.Goto Reference:=rangeName 'This will also select the range of cells. 
     On Error GoTo 0 'Reset default error handling. 
     selection.ClearContents 'Cannot use Selection.Delete because it will wipe out the rangeName. 

     Sheets(sourceWorksheet).Select 'Go to the source worksheet. 
     On Error GoTo SourceReferenceErrorHandler 
      Application.Goto Reference:=rangeName 'This will also select the range of cells. 
     On Error GoTo 0 'Reset default error handling. 
     selection.Copy 
     Sheets(targetWorksheet).Select 'Go to the target worksheet. 

     On Error GoTo TargetReferenceErrorHandler 
      Application.Goto Reference:=rangeName 'This will also select the range of cells. 
     On Error GoTo 0 'Reset default error handling. 

     selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _ 
      :=False, Transpose:=False 
     Application.CutCopyMode = False 

     Exit Sub 'Skip the error handlers below. 

    SourceWorksheetErrorHandler: 
     On Error GoTo 0 'Reset default error handling. 
     Call WorksheetErrorHandlerMessage(sourceWorksheet, "copied from") 
     Err.Raise 1001, "Module1::Copy_Detail_Rows()", "Unable to locate the source worksheet." 
     'Uncomment one of the following lines as needed. 
     'Resume 0 'Resumes with line that caused the error. 
     'Resume Next 'Resumes with line following the line which caused the error. 
     'Resume <line number or label> 'Resumes with line number or label provided. 
     Exit Sub 

    TargetWorksheetErrorHandler: 
     On Error GoTo 0 'Reset default error handling. 
     Call WorksheetErrorHandlerMessage(targetWorksheet, "copied to") 
     Err.Raise 1002, "Module1::Copy_Detail_Rows()", "Unable to locate the target worksheet." 
     Exit Sub 

    SourceReferenceErrorHandler: 
     On Error GoTo 0 'Reset default error handling. 
     Call ReferenceErrorHandlerMessage(sourceWorksheet, rangeName, "copied from") 
     Err.Raise 1003, "Module1::Copy_Detail_Rows()", "Unable to locate the source range." 
     Exit Sub 

    TargetReferenceErrorHandler: 
     On Error GoTo 0 'Reset default error handling. 
     Call ReferenceErrorHandlerMessage(targetWorksheet, rangeName, "copied to") 
     Err.Raise 1004, "Module1::Copy_Detail_Rows()", "Unable to locate the target range." 
     Exit Sub 

    End Sub 

    Private Sub WorksheetErrorHandlerMessage(worksheetName, operation) 
     MsgBox ("Cannot locate the worksheet: " & worksheetName & "." & vbCrLf & vbCrLf _ 
       & "Please select the worksheet where you want the detail rows " & operation _ 
       & " and name it: " & worksheetName & "." & vbCrLf & vbCrLf _ 
       & "Select the range of cells to be used for copy operation and run the macro, " _ 
       & "Create_Range_Name_For_Current_Selection." & vbCrLf & vbCrLf _ 
       & "Then you can re-run this macro. (Press Alt-F8 to view the macro menu.)" & vbCrLf & vbCrLf _ 
       & "Note: The range selection on the source worksheet can be multiple groups of cells, " _ 
       & "but the destination range on the target should be a single cell or row." _ 
       ) 
    End Sub 


    Private Sub ReferenceErrorHandlerMessage(worksheetName, rangeName, operation) 
     MsgBox ("Cannot locate the range: " & rangeName & " on sheet: " & worksheetName & "." & vbCrLf & vbCrLf _ 
       & "Please select the cell(s) where you want the detail rows " & operation & " and run the macro, " _ 
       & "Create_Range_Name_For_Current_Selection." & vbCrLf & vbCrLf _ 
       & "Then you can re-run this macro. (Press Alt-F8 to view the macro menu.)" & vbCrLf & vbCrLf _ 
       & "Note: The range selection can be multiple groups of cells." _ 
       ) 
    End Sub 


    Private Sub ShowSelectionAttributes() 
     'If the selection is not contiguous, the row count and column count are from the first block of cells. 
     MsgBox ("Current selection: " & vbCrLf _ 
       & " Address = " & selection.address() & vbCrLf _ 
       & " AddressLocal = " & selection.AddressLocal() & vbCrLf _ 
       & " Cells.Count = " & selection.Cells.Count() & vbCrLf _ 
       & " Rows.Count = " & selection.Rows.Count() & vbCrLf _ 
       & " Columns.Count = " & selection.Columns.Count() & vbCrLf _ 
       & " First row number = " & selection.row & vbCrLf _ 
       & " Last row number (calculated) = " & (selection.Rows.Count() + selection.row - 1) & vbCrLf _ 
       & " Last row number (from range) = " & Get_Last_Row_Number_From(selection) & vbCrLf _ 
       & " ActiveSheet.Name = " & ActiveSheet.Name() _ 
       ) 
    End Sub 

    Sub Create_Range_Name_For_Current_Selection() 
    ' 
    ' Create the named range based on the current cell selection. 
    ' This does not need to be a contiguous group of cells - it can be 
    ' multiple groups of cells anywhere on the page. 

     Dim rangeName 
     rangeName = "Status_Report" 'Consider using a global variable for this. 
     'Call ShowSelectionAttributes 'Displays a message box. Uncomment this if you want to see some of the attributes. 
     On Error Resume Next 
      ActiveSheet.Names(rangeName).Delete 'This just deletes the name, not the data in the range. 
     On Error GoTo 0 'Reset error handler. 
     'The RefersTo targetWorksheet name needs to be enclosed in single quotes in case it contains spaces. 
     ActiveSheet.Names.Add Name:=rangeName, _ 
      RefersTo:="='" & ActiveSheet.Name() & "'!" & selection.address() 
     'Use the RefersTo format above to pass Row and Column names e.g. "$A$7:$L$340" (Note $ is absolute - w/o $ is relative) 
     'Use the RefersToR1C1 format below to pass Row and Column number (default format when recording a macro). 
     'ActiveWorkbook.Worksheets("Macro_Test").Names.Add Name:="Status_Report_Detail_Rows", _ 
     ' RefersToR1C1:="=Macro_Test!R7C1:R340C12" 

    End Sub 
    Function Get_Column_Number_For(aColumnName) 
     'Utility function for converting column names to the corresponding numbers. 
     'In the Immediate window, ?Get_Column_Number_For("AZ") should return 52. 
     Get_Column_Number_For = Range(aColumnName & 1).Column 'Get column number from the cell at aColumnName and row number 1. 
    End Function 

    Function Get_Column_Name_For(aColumnNumber) 
     'Return the column name (letter(s)) corresponding to this column number. 
     'Use the cell at row 1, aColumnNumber to get the column name. 
     'In the Immediate window, ?Get_Column_Name_For(52) should return AZ. 
     Get_Column_Name_For = Get_First_Column_Name_From(Cells(1, aColumnNumber)) 
    End Function 

    Function Get_First_Column_Name_From(aRange) 
     'Return the column name (letter(s)) from the first cell in aRange. 
     'The range does not need to be contiguous. It can also be a single cell. Note that the first 
     'cell in a range may not be the furthest cell to the left. Cells selected by using the Ctrl key 
     'are listed in the order of selection. 
     'Get the column name for the current selection by calling Get_First_Column_Name_From(selection) 
     Get_First_Column_Name_From = Get_First_Column_Name_From_Address(Cells(aRange.row, aRange.Column).address) 
    End Function 

    Function Get_First_Column_Name_From_Address(aRangeAddress) 
     Get_First_Column_Name_From_Address = Split(aRangeAddress, "$")(1) 'Get the first element of the array. 
    End Function 

    Function Get_Last_Column_Name_From(aRange) 
     Get_Last_Column_Name_From = Get_Last_Column_Name_From_Address(aRange.address) 
    End Function 

    Function Get_Last_Column_Name_From_Address(aRangeAddress) 
     'Return the column name (letter(s)) from the last cell in aRange. 
     'The range does not need to be contiguous. It can also be a single cell. Note that the last 
     'cell in a range may not be the furthest cell to the right. Cells selected by using the Ctrl key 
     'are listed in the order of selection. 
     'Get the column name for the current selection by calling Get_Last_Column_Name_From(selection) 

     Dim rangeArray() As String 
     Dim rangeCount As Integer 
     Dim lastRangeGroup As String 
     Dim lastCellAddress As String 

     rangeArray = Split(aRangeAddress, ",") 'aRange can contain multiple groups separated by commas. 
     rangeCount = UBound(rangeArray) 
     lastRangeGroup = rangeArray(rangeCount) 
     rangeArray = Split(lastRangeGroup, ":") 'Split the last group on the colon (:) if it exists. 
     rangeCount = UBound(rangeArray) 
     lastCellAddress = rangeArray(rangeCount) 

     Get_Last_Column_Name_From_Address = Split(lastCellAddress, "$")(1) 'Get the first element of the array. 
    End Function 

    Function Get_First_Row_Number_From(aRange) 
     'Returns the row number as a string. 
     Get_First_Row_Number_From = aRange.row 
    End Function 

    Function Get_Last_Row_Number_From(aRange) 
     'Returns the row number as a string. 
     Get_Last_Row_Number_From = Get_Last_Row_Number_From_Address(aRange.address) 
    End Function 

    Function Get_Last_Row_Number_From_Address(aRangeAddress) 
     'Returns the row number as a string. 
     'We can't just add the first row to the row count because the range may not be contiguous. 
     'If the selection is not contiguous, the row count and column count are from the first block of cells. 
     'See http://msdn.microsoft.com/en-us/library/office/ff195745(v=office.15).aspx for info on Areas.Count. 
     'Return the number from the last cell in aRange. 
     'The range does not need to be contiguous. It can also be a single cell. Note that the last 
     'cell in a range may not be the furthest cell to the bottom/right. Cells selected by using the Ctrl key 
     'are listed in the order of selection. 
     'Get the last row number for the current selection by calling Get_Last_Row_Number_From(selection) 

     Dim rangeArray() As String 
     Dim rangeCount As Integer 
     Dim lastRangeGroup As String 
     Dim lastCellAddress As String 

     rangeArray = Split(aRangeAddress, ",") 'aRange can contain multiple groups separated by commas. 
     rangeCount = UBound(rangeArray) 
     lastRangeGroup = rangeArray(rangeCount) 
     rangeArray = Split(lastRangeGroup, ":") 'Split the last group on the colon (:) if it exists. 
     rangeCount = UBound(rangeArray) 
     lastCellAddress = rangeArray(rangeCount) 

     Get_Last_Row_Number_From_Address = Split(lastCellAddress, "$")(2) 'Get the second element of the array. 
                      'Note: It's really the third element because 
                      'there are two $ signs and it's a zero-based index. 
    End Function 
+0

谢谢你的回答。使用您提供的第一组代码,我收到运行时错误'424'对象需要?你知道为什么吗? –

+0

更新 - 我已经解决了这个问题,但我现在正在运行时错误9下标超出范围 –

+0

对不起,迟到的回应...我注意到有一个Get_Last_Row_Number_From(选择)函数的引用从代码中缺少我给你的。我添加了该功能和一些其他类似的功能。如果仍然出现错误,请尝试在代码中放置一个断点并使用调试器运行它。让我知道这是否有帮助。 –

相关问题