使用excel VBA从一个工作表到另一个工作表的剪切粘贴表

Question

我每周都会报告我正在运行。我有两个单独的工作表。在第一个工作表中，我输入了我的数据（预先有2列和未知行数的表），我想创建一个宏，我点击它，然后剪切所有这些数据，并将它们移动到另一个工作表。在粘贴表格的工作表中，我希望将数据粘贴为值（包括初始公式）并粘贴到上周的数据下方。

e.g。如果我从工作表1中从单元格A1：B7中剪切数据，我想在工作表2中粘贴单元格A7：B14中的值。下周，应将数据从工作表1中的单元格A1：B5剪切粘贴到工作表2中的单元格A15：B20

到目前为止我有这个代码，但我做错了。我是vba的初学者。

Sub Movetabletototal()
Dim Count As Integer
Dim Table As Range
Dim CountRange As Range

Worksheets("TOTAL").Select
Set CountRange = Range("A2:A1000")


Count = Application.WorksheetFunction.Count(CountRange) 
Worksheets("MIXER TOTAL").Select


Set Table = Range("P3:Q12")
Worksheets("TOTAL").Select
Worksheets("TOTAL").Range("A1").Select




ActiveCell.Offset(1, Count + 1).Select
ActiveCell.Value = Table
Worksheets("MIXER TOTAL").Select
Worksheets("MIXER TOTAL").Range("P3:Q12").Clear Contents

If Worksheets("TOTAL").Range("A2").Offset(1, Count) <> "" Then
  Worksheets("TOTAL").Range("A2").End(xlDown).Select
End If

End Sub

谢谢！

Answer 1

此代码成功执行此操作：

  

e.g。如果我从工作表1中删除单元格A1：B7中的数据，我想粘贴   Worksheet2中的值，单元格A7：B14。下周，数据应该   从工作表1中的单元格A1：B5切割到单元格A15：B20中   Worksheet2

根据您的评论进行修改：

在“MIXER TOTAL”上使用from ruamel import yaml d = {'a': 1, 'b': 2, 'c': 3} abc = yaml.comments.CommentedMap() abc['a'] = 100 abc['c'] = 300 abc['b'] = 200 base = [ ('foo', {1: {'a': 10}, 2: {'b': 20}}), ('bar', {1: {}, 2: abc}), ] data = yaml.comments.CommentedMap() default = yaml.comments.CommentedMap() for m, a in base: data[m] = a for k in sorted(d): default[k] = d[k] default.yaml_set_anchor('default') for m, a in data.items(): for k in sorted(a.keys()): u = yaml.comments.CommentedMap() u.update(a[k]) u.add_yaml_merge([(0, default)]) a[k] = u data.insert(0, None, default) x = yaml.round_trip_dump(data, width=100).replace('?\n:', '~:') print(x) 作为更改的数据，并在当前数据后粘贴到“TOTAL”表上的A：B列。

P3:Q12

根据需要更改这些范围。 （注意，目前如果您的数据来自P3：Q1000，它将复制所有范围。如果严格想要Sub Movetabletototal() Dim Count As Integer Dim copyRng As Range, pasteRng As Range Dim totalWS As Worksheet, mixerWS As Worksheet Set totalWS = Worksheets("TOTAL") Set mixerWS = Worksheets("MIXER TOTAL") Set copyRng = mixerWS.Range("P3:Q" & mixerWS.Cells(mixerWS.Rows.Count, 17).End(xlUp).Row) Dim newRow As Long newRow = totalWS.Cells(totalWS.Rows.Count, 1).End(xlUp).Row If newRow > 1 Then newRow = newRow + 1 copyRng.Copy totalWS.Range(totalWS.Cells(newRow, 1), totalWS.Cells(newRow + copyRng.Rows.Count, copyRng.Columns.Count)) copyRng.ClearContents End Sub ，则将P3:Q12更改为{{1} }}