Microsoft Excel宏编码问题 [英] Microsoft Excel Macro Coding Issue

问题描述

我有一个宏，但它似乎没有工作。我有一本有多工作表的工作簿。我基本上想将单元格B1，G1，M94复制到一个单独的摘要工作表中。复制的单元格比A4 B4和C4要比A5，B5和C5等更多。

我的编码如下。我试图使它只是做了一张，但需要大约10张所有不同的名字。

  Sub SummurizeSheets（）
 Dim ws As Worksheet 
 
 Application.ScreenUpdating = False 
表格（Summary）。激活
 
对于工作表中的每个ws 
如果ws.Name<> 17B CUNNINGHAM然后
 ws.Range（B1，G1，M94）。复制
工作表（摘要）。单元格（Rows.Count，3）.End（xlUp）.Offset 1，0）_ 
 .PasteSpecial（xlPasteValues）
结束如果
下一个ws 
 End Sub 
  

解决方案

您将遇到的问题是无法复制/粘贴一个范围，您尝试的方式（多个部分）。这应该工作： / p>

  Sub SummurizeSheets（）
 Dim ws As Worksheet，wsSummary As Worksheet 
 Dim c As Range 
 
 Application.ScreenUpdating = False 
设置wsSummary = Sheets（Summary）
'设置目标单元格
设置c = wsSummary.Range（A4）
 
对于工作表中的每个ws 
如果ws.Name<> 17B CUNNINGHAM和ws.Name<> 汇总然后
 ws.Range（B1）。复制
 c.PasteSpecial（xlPasteValues）
 ws.Range（G1）。复制
 c.Offset 0，1）.PasteSpecial（xlPasteValues）
 ws.Range（M94）。复制
 c.Offset（0,2）.PasteSpecial（xlPasteValues）
'将目标单元格移动一行down 
设置c = c.Offset（1，0）
结束如果
 
下一个ws 
 
 Application.ScreenUpdating = True 
结束Sub 
  

我已经使用目标单元格放置粘贴，然后可以将其粘贴到下一行你可以使用这个多张表。也从 For Each 中排除摘要表，并重新设置 ScreenUpdating

I have a Macro however it doesnt seem to be working. I have a workbook which has multipul worksheets. I basically want to copy cells B1, G1, M94 all to a seperate "Summary" worksheet. Copied Cells to go to A4 B4 and C4 than if there is more A5, B5 and C5 and so on.

The coding i have is below. I have tried to make it so it only did it for one sheet but need it for about 10 sheets all with different names.

Sub SummurizeSheets()
Dim ws As Worksheet

Application.ScreenUpdating = False
Sheets("Summary").Activate

For Each ws In Worksheets
    If ws.Name <> "17B CUNNINGHAM" Then
        ws.Range("B1, G1, M94").Copy
        Worksheets("Summary").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) _
            .PasteSpecial (xlPasteValues)
    End If
Next ws
End Sub

解决方案

The problem you will have is you cannot copy/ paste a range the way you have tried to (multiple sections).This should work:

Sub SummurizeSheets()
Dim ws As Worksheet, wsSummary As Worksheet
Dim c As Range

Application.ScreenUpdating = False
Set wsSummary = Sheets("Summary")
' Set destination cell
Set c = wsSummary.Range("A4")

For Each ws In Worksheets
    If ws.Name <> "17B CUNNINGHAM" And ws.Name <> "Summary" Then
        ws.Range("B1").Copy
        c.PasteSpecial (xlPasteValues)
        ws.Range("G1").Copy
        c.Offset(0, 1).PasteSpecial (xlPasteValues)
        ws.Range("M94").Copy
        c.Offset(0, 2).PasteSpecial (xlPasteValues)
        ' Move destination cell one row down
        Set c = c.Offset(1, 0)
    End If

Next ws

Application.ScreenUpdating = True
End Sub

I have used a destination cell to place the paste which you can then offset for the next row so you can use this for multiple sheets. Also excluded the Summary sheet from the For Each and reset the ScreenUpdating

这篇关于Microsoft Excel宏编码问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！