我试图将sheet1范围数据复制到sheet2范围,但没有复制

时间:2012-12-20 07:47:12

标签: excel vba excel-vba vbscript

我正在尝试将sheet1范围数据复制到sheet2范围,但不会复制任何内容。这是完整的代码,我试图实现的东西,但卡在基本的地方。请帮忙

编辑:我刚刚尝试了宏,这段代码也发生了同样的事情。请参阅快照,其中您可以看到Snap 1包含源数据,但也已选中但未复制到Snap 2.但是在那里选择了范围。

  Sub copy()
      Range("A1:J4").Select
      Selection.copy
      Sheets("Sheet2").Select
      ActiveSheet.Paste
      Application.CutCopyMode = False
      ActiveWorkbook.Save
  End Sub

enter image description here

enter image description here

更新

样式-1

     Option Explicit


     Dim objSheet1,objSheet2,TotalRows,TotalcolCopy,strPathExcel1

     Dim oXls  : Set oXls = CreateObject("Excel.Application")
     Dim aData ': aData = oWb.Worksheets(1).Range("$A2:$C10")
     Dim dicP  : Set dicP = CreateObject("Scripting.Dictionary")

     strPathExcel1 = "D:\WIPData\AravoMacro\Finalscripts\GE_Wing_To_Wing_Report.xlsx"
     oXls.Workbooks.open strPathExcel1

     Set objSheet1 = oXls.ActiveWorkbook.Worksheets(1)
     Set objSheet2 = oXls.ActiveWorkbook.Worksheets(2)


     TotalRows=oXls.Application.WorksheetFunction.CountA(objSheet1.Columns(1)) - 3
     TotalcolCopy=oXls.Application.WorksheetFunction.Match("Parent Business Process ID", objSheet1.Rows(3), 0)

   objSheet1.Range(objSheet1.Cells(4,1),objSheet1.Cells(TotalRows,TotalcolCopy)).Copy(objSheet2.Range("A1"))

    '=======================
     oXls.ActiveWorkbook.SaveAs strPathExcel1
     oXls.Workbooks.close
     oXls.Application.Quit
    '======================

样式-2

  Option Explicit


  Dim objSheet1,objSheet2,TotalRows,TotalcolCopy,strPathExcel1
  Dim oFS   : Set oFS  = CreateObject("Scripting.FileSystemObject")
  Dim oXls  : Set oXls = CreateObject("Excel.Application")
  Dim aData ': aData    = oWb.Worksheets(1).Range("$A2:$C10")
  Dim dicP  : Set dicP = CreateObject("Scripting.Dictionary")

  oXls.Workbooks.Open(oFs.GetAbsolutePathName("Test.xlsx"))
  Set objSheet1 = oXls.ActiveWorkbook.Worksheets(1)
  Set objSheet2 = oXls.ActiveWorkbook.Worksheets(2)


  TotalRows=oXls.Application.WorksheetFunction.CountA(objSheet1.Columns(1)) - 3
  TotalcolCopy=oXls.Application.WorksheetFunction.Match("Parent Business Process ID", objSheet1.Rows(3), 0)

  objSheet1.Range(objSheet1.Cells(4,1),objSheet1.Cells(TotalRows,TotalcolCopy)).Copy(objSheet2.Range("A1"))

  '=======================
  oXls.ActiveWorkbook.SaveAs "Test.xlsx"
  oXls.Workbooks.close
  oXls.Application.Quit
  '======================

你们可以告诉我Style-1和Style-2之间有什么区别。因为在Style-1中所有复制的数据都会被保存,而Style-2则不然。这个设计问题主要是我早上面临的整体问题。

Style-2以什么方式不完美?

1 个答案:

答案 0 :(得分:3)

从一个范围复制到另一个范围的最简单方法是重新编码宏。查看代码,TotalRowsLastCol的值是多少? 假设您有Match()返回的匹配数据,那么就有要复制的行

Option Explicit

Sub CopyPastes()
    Dim rng1 as Range
    Dim rng2 as Range

    Set rng1 = Sheets(1).Range("B2:C12")
    Set rng2 = Sheets(2).Range("B2")
    rng1.Copy
    rng2.PasteSpecial xlPasteValues
End Sub

所以在你的情况下,你能保持简单吗?删除以下行。只需指定Sheet2的起始范围并试用即可。此时您不必担心resize

替换它,

ObSheet2.Range(ObSheet2.Cells(4,1),ObSheet2.Cells(TotalRows,LastCol)).PasteSpecial

使用:coz你缺少粘贴特殊参数

ObSheet2.Range(ObSheet2.Cells(4,1),ObSheet2.Cells(TotalRows,LastCol)) _ 
.PasteSpecial xlPasteValues

或:这里没有任何花哨的细胞,但直接范围

ObSheet2.Range(ObSheet2.Range("A4").PasteSpecial xlPasteValues