Question

我有以下代码，现在有点工作，但我遇到了另一个问题。由于某种原因，它多次从同一工作表复制并粘贴到新工作簿。我认为这是由于我设置的NumRange + 100周长，因为我无法使LastRow变量起作用。

Public Sub extractCol()

'Find FF&E Section, Add 3 rows and Identify relevant columns.

Dim rFind As Range, CRange As String, ERange As String, KRange As String, MRange As String
Dim ws As Worksheet
Dim NewBook As Workbook
Dim NumRange As Long
Dim LastRow As Long

Set NewBook = Workbooks.Add ' Open new Workbook

For Each ws In ThisWorkbook.Worksheets
With ws
    Set rFind = .Range("A:A").Find(What:="FF&E", LookAt:=xlWhole,     MatchCase:=False, SearchFormat:=False)
    If Not rFind Is Nothing Then

        LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
        NumRange = rFind.Row + 3 ' Find FF&E line and add three

        CRange = "C" & NumRange & ":" & "C" & NumRange + 100 ' Define First 100 Lines in Column C
        ERange = "E" & NumRange & ":" & "E" & NumRange + 100 ' Define First 100 Lines in Column E
        KRange = "K" & NumRange & ":" & "K" & NumRange + 100 ' Define First 100 Lines in Column K
        MRange = "M" & NumRange & ":" & "M" & NumRange + 100 ' Define First 100 Lines in Column M

        Set range1 = Union(.Range(CRange), .Range(ERange), .Range(KRange), .Range(MRange)) ' Combine individual column ranges in to one selection
        range1.Copy ' Copy new combined range

        NewBook.Sheets(1).Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues ' Paste to new Workbook
        NewBook.Sheets(1).Range("A" & Rows.Count).End(xlUp)(2).Resize(range1.Rows.Count).Value = FindRoom(ws)

    End If
End With
Next ws

End Sub

Function FindRoom(ws As Worksheet)

shtName = ws.Name

Dim arr() As String
arr = VBA.Split(shtName, " ")

xCount = UBound(arr)
If xCount < 1 Then
    FindRoom = "Unknown"
Else
    FindRoom = arr(xCount)
End If
End Function

所以我尝试通过以下方式修复它;

            CRange = "C" & NumRange & ":" & "C" & LastRow
            ERange = "E" & NumRange & ":" & "E" & LastRow
            KRange = "K" & NumRange & ":" & "K" & LastRow
            MRange = "M" & NumRange & ":" & "M" & LastRow

但是这会导致以下行出错;

range1.Copy

任何有关我出错的地方的帮助都将受到赞赏。谢谢！

使用最后一行值复制联合范围

0 个答案: