Copy and Paste Macro Problem

tinamiller1

New member
Joined
Aug 28, 2013
Messages
16
Reaction score
0
Points
0
I have 18 macros in all. The first 8 macros get my sheets from other workbooks because our nurses send over 1 audit per workbook. In order to copy and paste all the items required into a single workbook and 3 sheets, we need them in one area. They are then sent to our Access DB to import to the DB and append to the tables he utilizes. I am sure there is an easier way to just put the sheets or the data straight into Access, however no one on the team knows how to do this. So, the macros are the best thing we have been able to get to work for the most part.

The problem is, macro 9 copies and pastes certain cells in the multiple sheets. When it copies, it does copy the correct information, however lines 1 through 52 are garbage. I can see based on what is pasting over that it is data on the mulitple sheets but not what I am asking for. I have tried researching why for over a month with no resolution. Right now the person I am training in Excel and to run the macros has on their list of instructions to just select rows 1 through 52, right click and delete. Rows 53 on down are the ones you want. It takes all of 2 seconds. However, in the long run, management wants a resolution because the project will probably change hands.

Here is my macro 9:

<code>
'macro nine
'copy cells for component table
Sub MACRO9()
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("macro.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 + 25)
Application.DisplayAlerts = False
vws.Range("b9").Copy
wsum.Range("a" & j).PasteSpecial (xlPasteFormulasAndNumberFormats)
vws.Range("h129").Copy
wsum.Range("b" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("a16:a32").Copy
wsum.Range("c" & j & ":c" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("b16:b32").Copy
wsum.Range("d" & j & ":d" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("c16:c32").Copy
wsum.Range("e" & j & ":e" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("d16:d32").Copy
wsum.Range("f" & j & ":f" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("f16:f32").Copy
wsum.Range("g" & j & ":g" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("g16:g32").Copy
wsum.Range("h" & j & ":h" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("h16:h32").Copy
wsum.Range("i" & j & ":i" & k).PasteSpecial (xlPasteValuesAndNumberFormats)
Application.DisplayAlerts = True
i = i + 25
End If
Next
End Sub
</code>

The reason for pastespecial is because there are some drop-down in certain cells and if I dont do a pastespecial, it copies everything in that drop-down and not just what our nurse selected in the cell. Could the reason it is doing this be because I have this as a prior macro:

<code>

'macro five
'copy cells for summary page that go into the main table
Sub MACRO5()
Dim ws As Worksheet, wsum As Worksheet
Dim wb As Workbook
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("macro.xlsm")
Set wsum = wb.Sheets("summary")
'Iterate through the sheets
For Each vws In wb.Sheets
If vws.Name <> "summary" Then
j = CStr(i + 1)
k = CStr(i + 1)
Application.DisplayAlerts = False
vws.Range("b9").Copy wsum.Range("a" & j)
vws.Range("b4").Copy wsum.Range("b" & j)
vws.Range("b5").Copy
wsum.Range("c" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("b6").Copy
wsum.Range("d" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("e6").Copy
wsum.Range("e" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("b10").Copy
wsum.Range("f" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("h129").Copy
wsum.Range("g" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("b12").Copy
wsum.Range("h" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("c12").Copy
wsum.Range("i" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("i1").Copy
wsum.Range("j" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("b123").Copy
wsum.Range("k" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("b125").Copy
wsum.Range("l" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("h124").Copy
wsum.Range("m" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
vws.Range("a127").Copy
wsum.Range("n" & j).PasteSpecial (xlPasteValuesAndNumberFormats)
Application.DisplayAlerts = True
i = i + 1
End If
Next
End Sub
</code>


***No, that is not it. I changed my DIMS and it did the same thing*****
 
Last edited:
Top