Question

我正在创建一本新书，然后在目录中打开文件，并将相应的工作表和值添加到新书中。我经历了很多表格，显示“复制目的地：=”或只有一个范围等于另一个，但我不能让我的脚本工作。一切正常（这只是一个片段，所以相信我98％的工作）除了在“工作簿（FileName）.Close”之前的这一行，在Else场景中。我通常会找到答案并弄明白，但我在这里转过身来。求救！

Dim SiteUsedCheck As Boolean
Dim NewBook As Workbook
Dim NewSheet As Worksheet
Dim SaveAsName As String
Dim WeekRange As Range

Set WeekRange = Range("I5:O17")

SaveAsName = "Invoice" & "_" & Home.Range("C23").Value & ".xlsm"
MsgBox SaveAsName

Set NewBook = Workbooks.Add
    With NewBook

                Do While FileName <> "" '<---recall FileName variable looks at excele books; it ignores folders

                    Workbooks.Open (Directory & FileName)

                        If Workbooks(FileName).Worksheets("TotalHours").Cells(SecretTest, WeekCol) = 0 Then

                            Workbooks(FileName).Close

                        Else
                            Dim TempSheetName As String
                            Set NewSheet = .Sheets.Add(After:=.Sheets(.Sheets.Count))
                            TempSheetName = Workbooks(FileName).Worksheets("TotalHours").Range("B2").Value
                            NewSheet.Name = TempSheetName

                            NewBook.Sheets(TempSheetName).Range("A1").Value = Workbooks(FileName).Sheets("TotalHours").Range("WeekRange") '<--This is the line that keeps getting an error. But if I put a "1" on the right side of the = it works. So what's wrong with this tiny piece?

                            Workbooks(FileName).Close

                        End If


                    FileName = Dir()

                Loop

        .SaveAs FileName:= _
            InvoiceDirectory & SaveAsName _
            , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

        Workbooks(SaveAsName).Close
    End With

Answer 1

最简单的方法是使用一些标准语法，如：

r1.Copy r2

其中r1和r2已被剔除为范围。这是一个很小的例子

Sub BooktoBook()
    Dim r1 As Range, r2 As Range, NewBook As Workbook
    Set r1 = ActiveWorkbook.Sheets("Sheet1").Range("A3:D7")

    Set NewBook = Workbooks.Add
    Set r2 = NewBook.Sheets("Sheet1").Range("A3:D7")

    r1.Copy r2
End Sub

Answer 2

也许

NewBook.Sheets(TempSheetName).Range("A1").resize(weekrange.rows.count,weekrange.columns.count).Value = WeekRange.value

Answer 3

谢谢大家，当我将我学到的东西与给予我的两个答案结合起来时，我重新设计了WeekRange，实际上是在正确的位置，如下面的代码所示。

Dim SiteUsedCheck As Boolean
Dim NewBook As Workbook
Dim NewSheet As Worksheet
Dim SaveAsName As String
Dim TempInvoiceRange As Range



SaveAsName = "Invoice" & "_" & Home.Range("C23").Value & ".xlsm"
MsgBox SaveAsName

Set NewBook = Workbooks.Add
    With NewBook

                Do While FileName <> "" '<---recall FileName variable looks at excele books; it ignores folders

                    Dim OpenRange As Range
                    Workbooks.Open (Directory & FileName)

                    Select Case Home.Range("C25")

                        Case Is = 1
                            Set WeekRange = Workbooks(FileName).Worksheets("TotalHours").Range("A5:G17")    '<---Range for Current Week to transfer to invoice
                            SecretTest = 18                                                                 '<---Row to check if site was used for the week
                            WeekCol = 7                                                                     '<---Column corresponding to current week
                        Case Is = 2
                            Set WeekRange = Workbooks(FileName).Worksheets("TotalHours").Range("I5:O17")
                            SecretTest = 18
                            WeekCol = 15
                        Case Is = 3
                            Set WeekRange = Workbooks(FileName).Worksheets("TotalHours").Range("Q5:W17")
                            SecretTest = 18
                            WeekCol = 23
                        Case Is = 4
                            Set WeekRange = Workbooks(FileName).Worksheets("TotalHours").Range("A19:G31")
                            SecretTest = 32
                            WeekCol = 7
                        Case Is = 5
                            Set WeekRange = Workbooks(FileName).Worksheets("TotalHours").Range("I19:O31")
                            SecretTest = 32
                            WeekCol = 15

                    End Select

                        If Workbooks(FileName).Worksheets("TotalHours").Cells(SecretTest, WeekCol) = 0 Then

                            Workbooks(FileName).Close

                        Else
                            Dim TempSheetName As String
                            Set NewSheet = .Sheets.Add(After:=.Sheets(.Sheets.Count))
                            TempSheetName = Workbooks(FileName).Worksheets("TotalHours").Range("B2").Value
                            NewSheet.Name = TempSheetName
                            NewBook.Sheets(TempSheetName).Range("A1").Resize(WeekRange.Rows.Count, WeekRange.Columns.Count).Value = WeekRange.Value
                            Workbooks(FileName).Close

                        End If


                    FileName = Dir()

                Loop

        .SaveAs FileName:= _
            InvoiceDirectory & SaveAsName _
            , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

        Workbooks(SaveAsName).Close
    End With

将一系列单元格从一个工作簿复制到另一个工作簿的正确语法是什么？

3 个答案: