複製多個範圍選擇

Question

我正在使用我在Google上找到的一些代碼。我試圖將數據複製到多張紙上，並將其粘貼到彙總表中。

我想將A23和H8：S8中的數據複製到彙總表上的空白行中。 A23將在列A和H8:S23將在列H到S。

這是我的，雖然它不工作。

Sub CopyRangeFromMultiWorksheets() 
    Dim sh As Worksheet 
    Dim DestSh As Worksheet 
    Dim Last As Long 
    Dim CopyRng As Range 

    With Application 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 


    ' Set Summary Worksheet. 
Set DestSh = ActiveWorkbook.Worksheets("Tab_Upload") 

    ' Loop through all worksheets and copy the data to the 
    ' summary worksheet. 
    For Each sh In ActiveWorkbook.Worksheets 
     If LCase(Left(sh.Name, 1)) = "_" Then 

      ' Find the last row with data on the summary worksheet. 
      Last = ActiveSheet.[a65536].End(xlUp).Row 

      ' Specify the range to place the data. 
      Set CopyRng = sh.Range("H8:S8, A23") 


      ' This statement copies values and formats from each 
      ' worksheet. 
      CopyRng.Copy 
      With DestSh.Cells(Last + 1, "A") 
       .PasteSpecial xlPasteValues 
       .PasteSpecial xlPasteFormats 
       Application.CutCopyMode = False 
      End With 



     End If 
    Next 

ExitTheSub: 

    Application.Goto DestSh.Cells(1) 

    ' AutoFit the column width in the summary sheet. 
    DestSh.Columns.AutoFit 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
    End With 
End Sub 

Answer 1

我試着設置了起來，我得到一個「該命令不能在多重選擇使用」我只是手動選擇並試圖複製兩個範圍。但是，如果兩個或多個範圍具有相同的列數，則沒有問題。我想這是因爲他們是不同的大小VBA不能很好地處理這些。嘗試通過一個做他們一個，像這樣：

Option Explicit 

Private Sub DoStuff() 

Dim ws As Worksheet 
Dim summary As Worksheet 
Dim rng As Range 

Set summary = ThisWorkbook.Sheets("Sheet4") 

For Each ws In ThisWorkbook.Worksheets 
    If ws.Name <> summary.Name Then 
     ws.Range("A1").Copy summary.Range("A" & summary.Range("A" & summary.Rows.Count).End(xlUp).Row + 1) 
     ws.Range("C1:D4").Copy summary.Range("A" & summary.Range("A" & summary.Rows.Count).End(xlUp).Row + 1) 
    End If 
Next ws 

End Sub 

編輯，如果複製多個範圍，它們必須具有相同的列數