Question

您好我正在尝试将数据从一系列工作簿复制到主文件中。主文件包含电子表格名称和作为字符串循环的工作表名称，我使该过程正常工作。但是现在我需要将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

Answer 1

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

所以不要这样：

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

See this link了解有关PasteSpecial方法的更多信息 See this link了解有关不同粘贴类型的更多信息。

在VBA中查找但复制包括注释在内的所有单元格内容

1 个答案: