从另一个 excel 文件（每个选项卡）复制和粘贴数据答案

【问题标题】：Copy and paste data from another excel file (each tab)从另一个 excel 文件（每个选项卡）复制和粘贴数据
【发布时间】：2022-08-24 21:13:49
【问题描述】：

我正在尝试从文件 (wb) 中的每个选项卡中复制列 f:g。每个选项卡都有不同数量的行，因此在选择范围时我还需要包含 ctrl+shift+down。粘贴到当前文件（ws）时，我还需要考虑偏移量，因为我每次都粘贴 2 列（彼此相邻）。

我尝试了以下代码，但我不断收到运行时错误（对象不支持此属性），我错过了什么？

    For i = 1 To wb.Sheets.Count
        wb.Range(\"f2:G2\").End(xlDown).Select.Copy
        start.Offset(i + 2, 2).PasteSpecial xlPasteValues
    Next i

看到这个并给它投票：stackoverflow.com/q/50776026/4961700
你说：我尝试了以下代码，但我一直收到错误消息，我错过了什么？您错过了这里没有人可以看到您的屏幕和错误消息的事实。请编辑您的问题并添加确切的错误消息。

标签： excel vba excel-formula

【解决方案1】：

从所有工作表中复制值

Sub Test()
    
    ' Before your code...
    
    Const sFirstRowAddress As String = "F2:G2"
    
    ' First part of your code...
    
    Dim wb As Workbook ' Set wb = ?
    Dim Start As Range ' Set Start = ?
    
    ' New code...
    
    ' Using the first source worksheet, calculate the total number of rows
    ' ('trCount') and the number of columns ('cCount').
    Dim trCount As Long
    Dim cCount As Long
    
    With wb.Worksheets(1).Range(sFirstRowAddress)
        trCount = .Worksheet.Rows.Count - .Row + 1
        cCount = .Columns.Count
    End With
    
    ' Reference the first destination row ('drrg').
    Dim drrg As Range: Set drrg = Start.Cells(1).Resize(, cCount)
    
    Dim sws As Worksheet
    Dim srg As Range
    Dim slCell As Range
    Dim drg As Range
    Dim rCount As Long
    
    For Each sws In wb.Worksheets
        ' Clear all filters.
        If sws.FilterMode Then sws.ShowAllData
        ' Reference the first source row...
        With sws.Range(sFirstRowAddress)
            ' Attempt to reference the last non-empty cell ('slCell').
            Set slCell = .Resize(trCount) _
                .Find("*", , xlFormulas, , xlByRows, xlPrevious)
            If Not slCell Is Nothing Then ' a non-empty cell was found
                rCount = slCell.Row - .Row + 1
                Set srg = .Resize(rCount)
                Set drg = drrg.Resize(rCount)
                drg.Value = srg.Value ' copy values
                Set drrg = drrg.Offset(rCount) ' next first destination row
            'Else ' all source cells are empty; do nothing
            End If
        End With
    Next sws
    
    ' The remainder of your code...

End Sub

【讨论】：