mduff
08-24-2010, 08:28 AM
Hi,
I have the following VBA that’s Kind of working What I am looking for it to do is look through all open workbooks and Copy J5 only if the sheet name is "Alignment Score Summary" or "Score" then paste the values in the active sheet.
Like I said it is sort of working but I am missing something and I am sure and I don’t know if I need the two loops or there is a better way to do this
Any help is appreciated
thanks a lot in advance
On Error Resume Next
'''' new sheet
For Each wbk In Workbooks
If wbk.Name <> ThisWorkBook.Name Then
'' wbk.Sheet1.Range("j5").Copy
wbk.Sheets("Alignment Score Summary").Range("j5").Copy
ThisWorkBook.Sheets(1).Range("A" & row).Select
'' ThisWorkBook.Sheets(1).PasteSpecial xlPaseValues
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
row = row + 1
End If
Next
'''' old sheet
On Error Resume Next
For Each wbk In Workbooks
If wbk.Name <> ThisWorkBook.Name Then
'' wbk.Sheet1.Range("j5").Copy
wbk.Sheets("Score").Range("j5").Copy
ThisWorkBook.Sheets(1).Range("A" & row).Select
'' ThisWorkBook.Sheets(1).PasteSpecial xlPaseValues
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
row = row + 1
End If
Next
End Sub
I have the following VBA that’s Kind of working What I am looking for it to do is look through all open workbooks and Copy J5 only if the sheet name is "Alignment Score Summary" or "Score" then paste the values in the active sheet.
Like I said it is sort of working but I am missing something and I am sure and I don’t know if I need the two loops or there is a better way to do this
Any help is appreciated
thanks a lot in advance
On Error Resume Next
'''' new sheet
For Each wbk In Workbooks
If wbk.Name <> ThisWorkBook.Name Then
'' wbk.Sheet1.Range("j5").Copy
wbk.Sheets("Alignment Score Summary").Range("j5").Copy
ThisWorkBook.Sheets(1).Range("A" & row).Select
'' ThisWorkBook.Sheets(1).PasteSpecial xlPaseValues
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
row = row + 1
End If
Next
'''' old sheet
On Error Resume Next
For Each wbk In Workbooks
If wbk.Name <> ThisWorkBook.Name Then
'' wbk.Sheet1.Range("j5").Copy
wbk.Sheets("Score").Range("j5").Copy
ThisWorkBook.Sheets(1).Range("A" & row).Select
'' ThisWorkBook.Sheets(1).PasteSpecial xlPaseValues
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
row = row + 1
End If
Next
End Sub