Question

我正在尝试仅复制和粘贴来自位于一个文件夹中的多个工作簿的特定范围内的值，这些工作簿都具有名为＆＃34; summary＆＃34;的工作表。下面的代码我使用粘贴格式和所有，我只想粘贴值。这是我目前的代码：

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Const strPath As String = "C:\Users\St\Desktop\ATP\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("SUMMARY").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("SUMMARY").Range("A2:AG" & LastRow).Copy wkbDest.Sheets("SHEET1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

如何更改它以便只粘贴值？

Answer 1

只需设置相等的值：

With wkbSource
    lastRow = .Sheets("SUMMARY").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
    wkbDest.Sheets("SHEET1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = .Sheets("SUMMARY").Range("A2:AG" & lastRow).Value
    .Close savechanges:=False
End With

注意：您可能需要将第一部分（...Offset(1,0).Value）调整为与原始信息相同的大小。我认为以下内容可行：

Dim infoToCopy As Range
Set infoToCopy = wkbSource.Sheets("SUMMARY").Range("A2:AG" & lastRow)
Dim firstRow As Long

With wkbSource
    lastRow = .Sheets("SUMMARY").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    firstRow = wkbDest.Sheets("SHEET1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    wkbDest.Sheets("SHEET1").Range("A" & firstRow & ":A" & firstRow + infoToCopy.Rows.Count - 1).Value = infoToCopy.Value
    .Close savechanges:=False
End With

仅将每个工作簿中特定工作表上的多个工作簿中的值复制并粘贴到Excel中的一个工作表中

1 个答案: