Help with a macro

[tmcrouse]

I have a macro that looks at a group of worksheets within my workbook. Some of the fields have hidden sheets that feed into a drop-down box. When I run the macro, it is copying items from the drop-down box and will ask me if I want to replace the data and I have to click the left mouse button everytime to say yes and it continues until the last worksheet is done. I have to click for everytime it selects information from a hidden sheet that feeds the drop-down. There are 4 drop-downs and 55 worksheets. I go through this every week when I get a new workbook in. I tried coding a do while statement but that just errors out. The code as I have it does not error, but makes it so I have to continue to click too many times to get through the sheet. It will also paste odd information in the first 15 cells and then go ahead and grab what is requested in the copy paste macro. I am attaching my macro below:

<code>

'macro nine
'copy cells for component table
Sub CopyCells2()
Dim ws As Worksheet, wsum As Worksheet
Dim wb As Workbook
Dim sfilename As String
Dim shname As String
Dim sh As Worksheet
Dim vws As Variant 'Need to use a Variant for iterator
Dim i As Integer, j As String, k As String
i = 0
'change the workbook name to match the name you are working with
Set wb = Workbooks("sheet16.xlsm")
Set wsum = wb.Sheets("summary2")
'Iterate through the sheets
For Each vws In wb.Sheets
If vws.Name <> "summary2" Then
j = CStr(i + 2)
k = CStr(i + 10)
vws.Range("b9").Copy wsum.Range("a" & j)
vws.Range("h129").Copy
wsum.Range("b" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("a16:a38").Copy
wsum.Range("c" & j & ":c" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("b16:b38").Copy
wsum.Range("d" & j & ":d" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("c16:c38").Copy
wsum.Range("e" & j & ":e" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("d16:d38").Copy
wsum.Range("f" & j & ":f" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("f16:f38").Copy
wsum.Range("g" & j & ":g" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("g16:g38").Copy
wsum.Range("h" & j & ":h" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("h16:h38").Copy
wsum.Range("i" & j & ":i" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
i = i + 10
End If
Next
End Sub
</code>

Any advice?

 

[timfritsch]

Have you tried the statement Application.DisplayAlerts = False? Add this before the first copy command and add Application.DisplayAlerts = True after the last PasteSpecial.

Hope this works...


Tim

 

[Michael M]

Maybe this

'macro nine
'copy cells for component table
Sub CopyCells2()
Dim ws As Worksheet, wsum As Worksheet, sh As Worksheet
Dim wb As Workbook, sfilename As String, shname As String
Dim vws As Variant 'Need to use a Variant for iterator
Dim i As Integer, j As String, k As String
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
i = 0
'change the workbook name to match the name you are working with
'Set wb = Workbooks("sheet16.xlsm")
'Set wsum = wb.Sheets("summary2")
'Iterate through the sheets
Application.DisplayAlerts = False
For Each vws In wb.Worksheets
If vws.Name <> "summary2" Then
j = CStr(i + 2)
k = CStr(i + 10)
vws.Range("b9").Copy wsum.Range("a" & j)
vws.Range("h129").Copy
wsum.Range("b" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("A16:H38").Copy
wsum.Range("c" & j & ":i" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
i = i + 10
End If
Next
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

 

[Michael M]

OOps typo

'macro nine
'copy cells for component table
Sub CopyCells2()
Dim ws As Worksheet, wsum As Worksheet, sh As Worksheet
Dim wb As Workbook, sfilename As String, shname As String
Dim vws As Variant 'Need to use a Variant for iterator
Dim i As Integer, j As String, k As String
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
i = 0
'change the workbook name to match the name you are working with
Set wb = Workbooks("sheet16.xlsm")
Set wsum = wb.Sheets("summary2")
'Iterate through the sheets
Application.DisplayAlerts = False
For Each vws In wb.Worksheets
If vws.Name <> "summary2" Then
j = CStr(i + 2)
k = CStr(i + 10)
vws.Range("b9").Copy wsum.Range("a" & j)
vws.Range("h129").Copy
wsum.Range("b" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("A16:H38").Copy
wsum.Range("c" & j & ":i" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
i = i + 10
End If
Next
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

 

[tmcrouse]

It works like a charm. Thanks

 

[Michael M]

Glad it worked...from both of us...