复制范围和粘贴值在另一个工作表的特定范围

我试图让一个Excel宏工作，但我有一个问题，从包含公式的单元格复制值。复制范围和粘贴值在另一个工作表的特定范围

到目前为止，这是我的，它与非公式单元格工作正常。

Sub Get_Data() 
Dim lastrow As Long 

lastrow = Sheets("DB").Range("A65536").End(xlUp).Row + 1 

Range("B3:B65536").Copy Destination:=Sheets("DB").Range("B" & lastrow) 
Range("C3:C65536").Copy Destination:=Sheets("DB").Range("A" & lastrow) 
Range("D3:D65536").Copy Destination:=Sheets("DB").Range("C" & lastrow) 
Range("E3:E65536").Copy Destination:=Sheets("DB").Range("P" & lastrow) 
Range("F3:F65536").Copy Destination:=Sheets("DB").Range("D" & lastrow) 
Range("AH3:AH65536").Copy Destination:=Sheets("DB").Range("E" & lastrow) 
Range("AIH3:AI65536").Copy Destination:=Sheets("DB").Range("G" & lastrow) 
Range("AJ3:AJ65536").Copy Destination:=Sheets("DB").Range("F" & lastrow) 
Range("J3:J65536").Copy Destination:=Sheets("DB").Range("H" & lastrow) 
Range("P3:P65550").Copy Destination:=Sheets("DB").Range("I" & lastrow) 
Range("AF3:AF65536").Copy Destination:=Sheets("DB").Range("J" & lastrow). 

End Sub

我怎样才能让它粘贴值呢？

如果这可以改变/优化，我也会很感激。

来源

2014-02-08 BlueSun3k1

您可以更改

Range("B3:B65536").Copy Destination:=Sheets("DB").Range("B" & lastrow)

到

Range("B3:B65536").Copy 
Sheets("DB").Range("B" & lastrow).PasteSpecial xlPasteValues

顺便说一句，如果你有xls文件（Excel 2003中），你会得到一个错误，如果你lastrow会更大3.

请尝试使用此代码：

Sub Get_Data() 
    Dim lastrowDB As Long, lastrow As Long 
    Dim arr1, arr2, i As Integer 

    With Sheets("DB") 
     lastrowDB = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 
    End With 

    arr1 = Array("B", "C", "D", "E", "F", "AH", "AI", "AJ", "J", "P", "AF") 
    arr2 = Array("B", "A", "C", "P", "D", "E", "G", "F", "H", "I", "J") 

    For i = LBound(arr1) To UBound(arr1) 
     With Sheets("Sheet1") 
      lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row) 
      .Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy 
      Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues 
     End With 
    Next 
    Application.CutCopyMode = False 
End Sub

请注意，上面的代码确定DB表中DB表的最后一个非空行，列A（变量lastrowDB）。如果你需要找到LASTROW在DB表中的每个目标列，用下一个修改：

For i = LBound(arr1) To UBound(arr1) 
    With Sheets("DB") 
     lastrowDB = .Cells(.Rows.Count, arr2(i)).End(xlUp).Row + 1 
    End With 

    ' NEXT CODE 

Next

你也可以用另一个方法代替Copy/PasteSpecial。更换

.Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy 
Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues

与

Sheets("DB").Range(arr2(i) & lastrowDB).Resize(lastrow - 2).Value = _ 
     .Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Value

来源

2014-02-08 15:54:03

谢谢您的回复。我尝试使用数组的第一个代码，并且出现“脚本超出范围”的错误，并且在将表格（“Sheet1”）更改为“DB”后，它只是没有做任何事情。就像FYI一样，我正在使用Excel 2010.我还没有尝试过其他选项。有什么建议么？ – BlueSun3k1

我也纠正了这部分。 >> arr1 = Array（“B”，“C”，“D”，“E”，“F”，“AH”，“AIH”，“AJ”，“J”，“P”，“AF”） “从AIH到AI并且这个固定的，仍然有同样的错误。 – BlueSun3k1

你应该将'Sheet1'换成'With With Sheets（Sheet1）''到你正在处理数据的表格名称_from。例如。如果将表单'mySheet'中的数据复制到'DB'表单中，则应将'Sheet1'（与'Sheets（“Sheet1”）'）一致更改为'mySheet'。如果您想从_active sheet_中复制，请将'With Sheets（“Sheet1”）'改为'With ActiveSheet'（它会将当前活动工作表中的数据复制到'DB'工作表中） –

怎么样，如果你在一个表到不同的纸张复印每列？示例：sheetheet的B行到sheet1的B行，mysheet的C行到sheet 2的B行...

来源

2016-12-16 07:38:15 Gem

这应该是一条评论 –

复制范围和粘贴值在另一个工作表的特定范围

回答

相关问题