2013-03-26 128 views
0

有人可以帮助您使用vba代码将范围从多个工作表(52周)复制到同一工作簿中的汇总表中。每个工作表中的范围相同。我希望数据被复制并在ssummary工作表中列52粘贴,从week1到第52周从多个工作表复制范围到单个工作表

我发现这个代码在网上:

Sub SummurizeSheets() 
    Dim ws As Worksheet 
    Application.ScreenUpdating = False 
    Sheets("Summary").Activate 
    For Each ws In Worksheets 
     If ws.Name <> "Summary" Then 
      ws.Range("F46:O47").Copy 
      Worksheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues) 
     End If 
    Next ws 
End Sub 
+0

你试过了什么? – 2013-03-26 12:33:15

+0

Sub SummurizeSheets()Dim ws As Worksheet Application.ScreenUpdating = False Sheets(“Summary”)。Activate For Each ws In Worksheets If ws.Name <>“Summary”Then ws.Range(“F46:O47”)。Copy Worksheets (“Summary”)。Cells(Rows.Count,1).End(xlUp).Offset(1,0).PasteSpecial(xlPasteValues)End If Next ws End Sub – user2211547 2013-03-26 12:36:27

+0

运行此代码时会出现什么错误? – 2013-03-26 12:40:21

回答

1

试试下面的代码。也设置应用。 ScreenUpdating = True

Sub SummurizeSheets() 
    Dim ws As Worksheet 
    Dim j As Integer, col As Integer 

    Application.ScreenUpdating = False 

    Sheets("Summary").Activate 


    For Each ws In Worksheets 
     If ws.Name <> "Summary" Then 
      ws.Range("k3:k373").Copy 

      col = Worksheets("Summary").Range("IV1").End(xlToLeft).Column + 1 
      Worksheets("Summary").Cells(1, col).PasteSpecial xlPasteValues 
      Application.CutCopyMode = False 

     End If 

    Next ws 
    Columns(1).Delete 
    Range("A1").Activate 
    Application.ScreenUpdating = True 
End Sub 
+0

嗨,谢谢,但代码是从工作表中复制公式而不是值? – user2211547 2013-03-26 16:01:25

+0

@ user2211547我已经更新了代码。请检查我是否有任何问题。 – 2013-03-26 16:36:42

+0

差不多......!它复制数据,但粘贴第一个工作向导后创建一个空白列。第二张纸后有2个空白栏,第三张纸后有3张空白纸等。 – user2211547 2013-03-26 16:40:08

相关问题