Question

我正在从所有打开的工作簿中复制一个范围，目的是将复制的单元格粘贴到主（活动）工作簿中的合并工作表中。我只需要粘贴值，但使用此代码会收到“行尾”错误消息

花了整整一天时间搜索我的问题无济于事

Sub Consolidate()
Dim oBook As Workbook, ws As Worksheet, wb As Workbook, bk As Workbook
Dim copyFrom As Range

'Disable Screen Updating - stop screen flickering
'   And Disable Events to avoid inturupted dialogs / popups
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'Delete the Consolidate_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True

'Add a new WorkSheet and name as 'Consolidate_Data'
With ActiveWorkbook
    Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    DstSht.Name = "Consolidate_Data"
End With

'Loop through each WorkBook in the folder and copy the data to the 'Consolidate_Data' WorkSheet in the ActiveWorkBook
Set wb = ActiveWorkbook
For Each oBook In Application.Workbooks
    If Not oBook.Name = wb.Name Then

        'Find the last row on the 'Consolidate_Data' sheet
        DstRow = fn_LastRow(DstSht) + 1

        'Determine Input data range
        Set copyFrom = oBook.Worksheets(1).Range("A6:C8")

        'Copy data to the 'consolidated_data' WorkSheet
        copyFrom.Copy _
            DstSht.Range("A" & DstRow).PasteSpecial xlPasteValues

    End If
Next

IfError:

'Enable Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

'Find the last Row of specified Sheet
Function fn_LastRow(ByVal Sht As Worksheet)

    Dim lastRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow

End Function
 Consolidate()
Dim oBook As Workbook, ws As Worksheet, wb As Workbook, bk As Workbook
Dim copyFrom As Range

'Disable Screen Updating - stop screen flickering
'   And Disable Events to avoid inturupted dialogs / popups
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'Delete the Consolidate_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True

'Add a new WorkSheet and name as 'Consolidate_Data'
With ActiveWorkbook
    Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    DstSht.Name = "Consolidate_Data"
End With

'Loop through each WorkBook in the folder and copy the data to the 'Consolidate_Data' WorkSheet in the ActiveWorkBook
Set wb = ActiveWorkbook
For Each oBook In Application.Workbooks
    If Not oBook.Name = wb.Name Then

        'Find the last row on the 'Consolidate_Data' sheet
        DstRow = fn_LastRow(DstSht) + 1

        'Determine Input data range
        Set copyFrom = oBook.Worksheets(1).Range("A6:C8")

        'Copy data to the 'consolidated_data' WorkSheet
        copyFrom.Copy _
            DstSht.Range("A" & DstRow).PasteSpecial xlPasteValues

    End If
Next

IfError:

'Enable Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

'Find the last Row of specified Sheet
Function fn_LastRow(ByVal Sht As Worksheet)

    Dim lastRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow

End Function

在PasteSpecial行获取错误消息。一切都正常，没有特殊的粘贴，但是，由于复制的范围包括公式，因此无法获得所需的值。

Answer 1

.Copy和.PasteSpecial必须在2行中完成，但是您将行与_串联在一起

copyFrom.Copy _
   DstSht.Range("A" & DstRow).PasteSpecial xlPasteValues

将其更改为：

copyFrom.Copy 'no line concatenation here !
DstSht.Range("A" & DstRow).PasteSpecial xlPasteValues

有关更多信息，请参见文档：

使用PasteSpecial时收到错误消息“预期的行尾”

1 个答案: