0

嗨，我正在尝试将一系列工作簿中的数据复制到主文件中。主文件包含电子表格名称和作为字符串循环的工作表名称，我让该过程正常工作。但现在我需要将 A 列和第 1 行中的名称与每个工作表中的数据进行匹配，并复制包含任何注释的单元格。我有 vlookup 工作，但它不会复制评论。因此，我尝试执行几个匹配语句来查找单元格列号和行号，但似乎无法使其正常工作。有任何想法吗？？

Sub GroupTwo()
Dim path As String
Dim i As Integer
Dim Dsheet As String
Dim wb As Workbook
Dim upi
Dim cmt As Comment
Dim iRow As Integer
Dim col As Integer
Dim lookrange As Range
Dim G2 As Worksheet
Dim colRange As Variant
Dim rowRange As Range
Dim rowCell As Variant
Dim colCell As Variant

Set lookrange = ThisWorkbook.Sheets("Lookups").Range(ThisWorkbook.Sheets("Lookups").Cells(3, 1), ThisWorkbook.Sheets("Lookups").Cells(11, 2))
Set G2 = ThisWorkbook.Sheets("Group_two")

Application.DisplayAlerts = False
upi = 2
coln = 2
For i = 60 To 61
    path = ThisWorkbook.Sheets("Sheet7").Cells(1, i).Value
    Dsheet = ThisWorkbook.Sheets("Sheet7").Cells(2, i).Value
    Set wb = Workbooks.Open(path)
    Set colRange = wb.Sheets(Dsheet).Range(wb.Sheets(Dsheet).Cells(4, 2), wb.Sheets(Dsheet).Cells(4, 56))
    Set rowRange = wb.Sheets(Dsheet).Range(wb.Sheets(Dsheet).Cells(7, 1), wb.Sheets(Dsheet).Cells(27, 1))
    For c = 2 To 57
        For r = 8 To 73
            Set rowCell = Application.Match(G2.Cells(r, 1), rowRange, 0)
            Set colCell = Application.Match(G2.Cells(4, c), colRange, 0)
            wb.Sheets(Dsheet).Range(rowCell, colCell).Copy
            G2.Cells(r, c).PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


        Next r
    Next c
    do some stuff with the comment
    wb.Close SaveChanges:=False
Next i
4

1 回答 1

0

您是否考虑过同时复制所有内容？

所以代替这个：

G2.Cells(r, c).Value = wb.Sheets(Dsheet).Range(rowCell, ColCell, colRange, 0)).copy

也许你可以这样做：

wb.Sheets(Dsheet).Range(rowCell, ColCell, colRange, 0)).copy
G2.Cells(r, c).PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

有关该方法的更多信息，请参阅此链接PasteSpecial。
有关不同粘贴类型的更多信息，请参阅此链接。

于 2013-11-11T05:54:26.603 回答