將多個工作表但不是所有工作表的值複製/粘貼到一個工作表中

我需要從多個工作表複製單元格B3：W400（每次運行時都會有不同的名稱）並將值粘貼到「CombinedPlans」中，在最後添加每個新選擇。我需要從代碼中排除3張：IBExport，MonthlyIBs和組合計劃。將多個工作表但不是所有工作表的值複製/粘貼到一個工作表中

大量的反覆試驗給了我下面的代碼，我在我的「練習」工作簿中工作。現在，我已將它放入我的製作工作簿中，不再複製任何工作表。它只是直接跳到消息框。我究竟做錯了什麼？

Sub consolidatetest() 

Sheets("CombinedPlans").Select 
Range("B3:W1048576").Select 
Selection.ClearContents 

Dim J As Integer 
Dim sh As Worksheet 
Const excludeSheets As String = "QBExport,MonthlyIBs,CombinedPlans" 

On Error Resume Next 
For Each sh In ActiveWorkbook.Worksheets 
If IsError(Application.Match(sh.Name, Split(excludeSheets, ","))) Then 
     Application.GoTo Sheets(sh.Name).[b3] 
     Range("B3:W400").Select 
     Selection.Copy 
     Worksheets("CombinedPlans").Activate 
    Range("B1048576").End(xlUp).Offset(rowOffset:=1, columnOffset:=0).PasteSpecial xlPasteValues 
    End If 
Next 
Application.CutCopyMode = False 
MsgBox "Complete!" 

End Sub

來源

2016-01-28 Faith Mitchell

這裏是另一個你可以調查http://www.xlorate.com/vba-examples.html#Loop%20Through%20Folder – Davesexcel

這應該工作。如果仍有問題，請確保表格CombinedPlans確實如此命名。

Sub consolidatetest() 

Dim wb As Workbook 
Dim sh_CombPlans As Worksheet 

Set wb = ThisWorkbook 
Set sh_CombPlans = wb.Sheets("CombinedPlans") 
sh_CombPlans.Range("B3:W1048576").ClearContents 

Dim sh As Worksheet 

For Each sh In ActiveWorkbook.Worksheets 
    Select Case sh.Name 
     Case "QBExport", "MonthlyIBs", "CombinedPlans": 
      'Do Nothing 
     Case Else 
      sh.Range("B3:W400").Copy 
      sh_CombPlans.Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
    End Select 
Next 

Application.CutCopyMode = False 
MsgBox "Complete!" 

End Sub

來源

2016-01-28 20:54:43

遺憾的是它仍然是在sh_CombPlans.Range（「B1048576」）示數出來。完（xlUp）.Offset（1,0）.PasteSpecial xlPasteValues ... –

哦，我相信這是因爲一些細胞被合併。我可能需要編寫一些代碼來說明這一點。謝謝！ –

Oux ..合併單元格總是有問題的VBA。我想你可以在複製前「解散」他們。 –

將多個工作表但不是所有工作表的值複製/粘貼到一個工作表中

回答

相關問題