从一个工作簿复制选定的单元格并复制到另一个工作簿

Question

我正在尝试创建一个数据库，该数据库将从主工作簿复制选定范围的数据并复制到单独的工作簿中。

导致问题的代码如下。第二个工作簿基于“W2”的值打开。应将新行插入到新的 Wb 中并格式化，然后粘贴所选单元格的值。

'Select data to be copied
ActiveCell.Resize(1, 4).Copy

'Open Lessons Learned Db
Location = Range("W2").Value
Set Lessons = Workbooks.Open(Location)
Set LL = Sheets("Lessons Learned")
Windows("Lessons Learned Database.XLSM").Activate
Sheets("Lessons Learned").Activate

'Insert New Row
Range("5:5").Activate
ActiveCell.Offset(1).EntireRow.Insert
'Enter Odd Or Even VALUE
    Range("A7").Select
    OE = ActiveCell.Value
    If OE = 1 Then
        Range("A6").Select
        ActiveCell.FormulaR1C1 = 0
    Else
        Range("A6").Select
        ActiveCell.FormulaR1C1 = 1
    End If

'Hide Permanently Hidden Rows -LINE BELOW GIVES ERROR 1004
    Rows("5:5").Select
    Selection.EntireRow.Hidden = True
    Columns("A").Select
    Selection.EntireColumn.Hidden = True
'FORMAT ROW
    Range("A6").Select
    SC = ActiveCell.Value
        If SC = 1 Then
    Range("B6:N6").Select
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With

End If
Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

任何关于我哪里出错的指针将不胜感激。

Answer 1

建议不要使用.Select 或.Activate，因为还有其他方法可以做到这一点。
因为您选择并激活了这可能会导致ERROR 1004。

下面我已经“清理”了您定义 Lessons、LL 和 Location 的代码，并包含了 MainWB 并定义了您的范围。

通过定义您的Range Excel 将始终从该Range 获得.Value，因此无需使用.Select 或.Activate。

就测试而言，以下代码有效：

Sub CopyMainWBtoNewWB()

Dim Lessons As Workbook
Dim LL As Worksheet
Dim MainWB As Workbook
Dim Location As String

Set MainWB = Workbooks("Name Here")

'Open Lessons Learned Db
Location = MainWB.Sheets("Sheet Name").Range("W2").Value
Set Lessons = Workbooks.Open(Location)
Set LL = Lessons.Sheets("Lessons Learned")

'Insert New Row
LL.Rows(5).Offset(1).EntireRow.Insert shift:=xlDown

'Enter Odd Or Even VALUE
If LL.Range("A7").Value = 1 Then
    LL.Range("A6").Value = 0
Else
    LL.Range("A6").Value = 1
End If

'Hide Permanently Hidden Rows -LINE BELOW GIVES ERROR 1004
LL.Rows(5).Hidden = True
LL.Columns(1).Hidden = True

'FORMAT ROW

If LL.Range("A6").Value = 1 Then
    With LL.Range("B6:N6").Interior
        .ColorIndex = 15
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
End If
MainWB.Sheets("Sheet1").Range("A1:A4").Copy
LL.Range("B5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub

您需要做的就是更改MainWB 的Workbook 名称和Sheet 名称，它收集Valuefor Location。

Answer 2

我怀疑您的代码存在一些其他问题，代码审查可能会帮助解决您的问题：

Rows("5:5").Select 被传递了错误的参数数据类型。

Worksheet.Rows() 需要一个数字，整数或长数据类型，但你给它的是一个字符串。

将其更改为Rows(5)，它应该可以工作。

Answer 3

所有这些都可以合并为：

ActiveCell.Resize(1, 4).Copy '// not sure what this is for

Set Lessons = Workbooks.Open([w2])
Set LL = Lessons.Sheets("Lessons Learned")

With LL
    .Rows(6).EntireRow.Insert
    .Range("A6").value = IIf(.Range("A7").value = 1, 0, 1)
    .Rows(5).Hidden = True
    .Columns("A").Hidden = True
        If .Range("A6").value = 1 Then
            With .Range("B6:N6").Interior
                .ColorIndex = 15
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
        End If
    .Range("B5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
End With

您会注意到，此代码直接引用每个对象，而无需激活或选择它。以这种方式编码意味着每个对象都是完全限定的，并且您确切地知道您正在使用哪个实例。

这应该确保该行被正确隐藏而没有错误，因为您指的是Rows 集合，它是具有定义属性和方法的Ranges 的集合。 Selection 可以是工作表、工作簿、图表、范围或几乎任何您可以指向并单击的其他内容 - 因此在尝试访问属于特定对象或类的属性或方法时可能会导致问题。