Question

我正在编辑此帖子以提供更多详细信息。

这是尝试将源工作簿中许多工作表（大约90）中特定范围的值复制到目标工作簿中许多工作表中的相同特定范围。源和目标工作簿中的工作表具有相同的名称。

例如，对于名称为＆＃34; A＆＃34;的工作表。通过＆＃34; N＆＃34;，算法可能类似于：

Copy from SourceWorkbook.Worksheet("A").Range ("H46:H85")
PasteValues to DestinationWorkbook.Worksheet("A").Range ("H46:H85")
.
.
.
Copy from SourceWorkbook.Worksheet("N").Range ("H46:H85")
PasteValues to DestinationWorkbook.Worksheet("N").Range ("H46:H85")

当我尝试仅允许在目标名称与源名称相同时发生粘贴时发生错误。

这是我到目前为止所做的。

Sub TestGetReview_5()

'still not working

Dim ToWb As Workbook
Dim FromWb As Workbook

Dim FromSht As Worksheet
Dim ToSht As Worksheet
Dim SheetName As String 'not sure this is needed

Set FromWb = Workbooks("SourceWorkbook.xlsm") 'wb is open  
Set ToWb = Workbooks("DestinationWorkbook.xlsm")  'wb is open  

For Each FromSht In FromWb.Worksheets
If FromSht.Name Like "N*" And FromSht.Name <> "Notes" Then

SheetName = FromSht.Name
FromWb.Activate
FromSht.Activate
Range("H46:H85").Copy
ToWb.Activate
Set ToWb.ToSht.Sheets(SheetName) = FromWb.FromSht.Sheets(SheetName)  'Attempt to only allow pasting if Destination worksheet name is same as source worksheet name produces error "object doesn't support this property or method". Variable SheetName is correctly set to first ws in source wb
ToSht.Activate
Range("H46:H85").PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End If
Next FromSht

End Sub

我非常感谢你的帮助！

Answer 1

你需要一个神奇的代码行，使用.Value2作为批量getter和setter。

试试这个

Option Explicit

Sub Test()

    Dim lLoop As Long
    For lLoop = Asc("A") To Asc("N")
        DestinationWorkbook.Worksheet(Chr(lLoop)).Range("H46:H85").Value2 = SourceWorkbook.Worksheet(Chr(lLoop)).Range("H46:H85").Value2
    Next
End Sub

Answer 2

错误的直接原因是FromWb引用了一个Workbook对象，它表示一个Excel工作簿。 Workbook个对象没有任何名为FromSht的属性或方法，因此该表达式失败：

    FromWb.FromSht

您似乎在滥用Set声明，其中包含：

为变量或属性指定对象引用。

它不会强制执行任何形式的平等或名称相似性。为此，你必须进行某种比较：

If FromSht.Name = ToSht.Name Then
    'do something here
End If

如果Option Explicit没有显示在您模块的顶部，那么它应该。

Option Explicit强制您在使用变量之前声明变量，并有助于捕获拼写错误和其他错误声明的变量。

如果我们尝试访问不存在的工作表，我们只会收到错误消息。为了简化操作，我们可以编写一个带有工作簿和名称的函数，如果我们可以通过该名称成功访问工作表，则返回该工作表。否则，该函数将返回Nothing，这意味着它不会引用任何工作表。

Function SafeGetWorksheet(book As Workbook, name As String) As Worksheet
    On Error GoTo ErrorHandler
    Set SafeGetWorksheet = book.Sheets(name)
    Exit Function

ErrorHandler:
End Function

然后，代码可以这样写：

Dim source As Workbook
Set source = Workbooks("SourceWorkbook.xlsm") 'wb is open

Dim destination As Workbook
Set destination = Workbooks("DestinationWorkbook.xlsm")  'wb is open

Dim sheet As Worksheet
'The following For Each will iterate through all the sheets in the source workbook
'You may want to limit the source sheets somehow, as in S.Meaden's answer
For Each sheet In source.Sheets 
    Dim destinationSheet As Worksheet
    Set destinationSheet = SafeGetWorksheet(destination,sheet.Name)

    'If there is a worksheet with the same name in the destination
    If Not destinationSheet Is Nothing Then
        'copy the cells from the source sheet's range to the destination sheet's range
        destinationSheet.Range("H46:H85").Value = sheet.Range("H46:H85").Value
    End If
Next

VBA References：

Excel object model reference：

Answer 3

所以你想从一张纸上的每一行复制并粘贴到另一张纸上的同一行，右边。

For Each Cell In Sheets("Sheet1").Range("J1:J" & LastRow1)
    If Cell.Value = "x" Or Cell.Value = "X" Then
        matchRow = Cell.Row
        Rows(matchRow & ":" & matchRow).Select
        Selection.Copy
        Sheets("Sheet2").Select
        ActiveSheet.Rows(matchRow).Select
        Selection.PasteSpecial
        Sheets("Sheet1").Select
    End If
Next

我假设ColumnJ中有一个'X'，这是标准或标志，表示你需要进行复制/粘贴。

VBA将源工作簿的许多工作表中的特定范围的值复制到目标工作簿

3 个答案: