从另一个excel文件复制和粘贴数据(每个选项卡)

Question

我正试图从文件(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

Answer 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
' Turn off AutoFilter.
If sws.AutoFilterMode Then sws.AutoFilterMode = False
' 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