2015-07-02 143 views
1

我在網上搜索了一下,但還沒有找到任何完全一樣的問題。我正在嘗試複製多個單獨的區域,並將它們粘貼到另一個表單上的一行中。這是我迄今爲止所做的。複製多個範圍並粘貼爲一個統一範圍(在列中)

Sub CopyTitle() 
    Dim range1 As Range 
    Dim range2 As Range 
    Dim range3 As Range 
    Dim range4 As Range 
    Dim range5 As Range 
    Dim range6 As Range 
    Dim range7 As Range 
    Dim range8 As Range 
    Dim range9 As Range 
    Dim range10 As Range 
    Dim range11 As Range 
    Dim multipleRange As Range 
    Set range1 = Sheets("RAW").Range("B8") 
    Set range2 = Sheets("RAW").Range("D9") 
    Set range3 = Sheets("RAW").Range("F10") 
    Set range4 = Sheets("RAW").Range("F12") 
    Set range5 = Sheets("RAW").Range("F14") 
    Set range6 = Sheets("RAW").Range("D15") 
    Set range7 = Sheets("RAW").Range("F16") 
    Set range8 = Sheets("RAW").Range("F18:F21") 
    Set range9 = Sheets("RAW").Range("F23:F24") 
    Set range10 = Sheets("RAW").Range("F26:F33") 
    Set range11 = Sheets("RAW").Range("F35:F40") 
    Set multipleRange = Union(range1, range2, range3, range4, range5, range6, range7, range8, range9, range10, range11) 
    multipleRange.Copy 
    Sheets("RAW").Cells(10, 10).PasteSpecial Transpose:=True 
End Sub 

我在multipleranges.copy中收到一個錯誤。它說多個範圍不能被複制。我能做些什麼來實現我的目標?

回答

1

你可以得到你需要把範圍到一個數組,然後通過數組循環什麼。此外,當測試下面的代碼,我不得不設置Transpose:=False讓它爲我工作...

Sub CopyTitle() 

    Dim rArray(1 To 11) As Range 

    Set rArray(1) = Sheets("RAW").Range("B8") 
    Set rArray(2) = Sheets("RAW").Range("D9") 
    Set rArray(3) = Sheets("RAW").Range("F10") 
    Set rArray(4) = Sheets("RAW").Range("F12") 
    Set rArray(5) = Sheets("RAW").Range("F14") 
    Set rArray(6) = Sheets("RAW").Range("D15") 
    Set rArray(7) = Sheets("RAW").Range("F16") 
    Set rArray(8) = Sheets("RAW").Range("F18:F21") 
    Set rArray(9) = Sheets("RAW").Range("F23:F24") 
    Set rArray(10) = Sheets("RAW").Range("F26:F33") 
    Set rArray(11) = Sheets("RAW").Range("F35:F40") 

    Dim i, j As Integer 

    For i = 1 To 11 
    rArray(i).Copy 
    j = 0 
    Do Until Sheets("RAW").Cells(10 + j, 10).Value = "" 'loop down until you reach the next blank cell... 
     j = j + 1 
    Loop 
    Sheets("RAW").Cells(10 + j, 10).PasteSpecial Transpose:=False 
    Next 

End Sub 
+0

我檢查這個! –

+0

看起來不錯!謝謝 –

0

您不能複製具有多個區域的範圍。您將不得不一次在一個範圍內傳輸數據。使用Range.Areas,你可以看到你有多個區域的多個區域。

相關問題