PDA

View Full Version : Solved: Have code check for 2 sheet names and copy values from them



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

GTO
08-24-2010, 09:34 AM
Not tested:


Option Explicit

Sub exa()
Dim wb As Workbook
Dim wks As Worksheet

On Error Resume Next
For Each wb In Workbooks

If Not wb.Name = ThisWorkbook.Name Then

Set wks = wb.Worksheets("Alignment Score Summary")
If Not wks Is Nothing Then
With Sheet1 ' ThisWorkbook.Worksheets(1)
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Value = wks.Range("J5").Value
End With
Set wks = Nothing
End If
Set wks = wb.Worksheets("Score")
If Not wks Is Nothing Then
With Sheet1
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Value = wks.Range("J5").Value
End With
Set wks = Nothing
End If
End If

Next
On Error GoTo 0
End Sub

mduff
08-26-2010, 09:57 AM
thank you very much I am sure it something simple but I can't seem to figure it out @ With Sheet1 in the line below
it gives a Compile error

Variable not defined



Set wks = wb.Worksheets("Alignment Score Summary")
If Not wks Is Nothing Then
With Sheet1 ' ThisWorkbook.Worksheets(1)
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Value = wks.Range("J5").Value



Any adtional help will be much apriceated

thanks!!!!

mohanvijay
08-26-2010, 01:23 PM
Hai Try This

and i attached sample file




Dim wb As Workbook
Dim x As Integer

x = 1

For Each wb In Workbooks

If wb.Name <> ThisWorkbook.Name Then

For i = 1 To wb.Sheets.Count

If wb.Sheets(i).Name = "Alignment Score Summary" Or wb.Sheets(i).Name = "Score" Then

ThisWorkbook.ActiveSheet.Cells(x, 1).Value = wb.Sheets(i).Range("j5").Value
x = x + 1

End If

Next i

End If

Next

GTO
08-27-2010, 04:18 AM
thank you very much I am sure it something simple but I can't seem to figure it out @ With Sheet1 in the line below
it gives a Compile error

Variable not defined



Set wks = wb.Worksheets("Alignment Score Summary")
If Not wks Is Nothing Then
With Sheet1 ' ThisWorkbook.Worksheets(1)
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Value = wks.Range("J5").Value


Any adtional help will be much apriceated

thanks!!!!

Sorry. You were using the worksheet's index, I just substituted with a sheet's codename for testing, but forgot to take it out. To fix:


With ThisWorkbook.Worksheets(1)

Mark

mduff
08-27-2010, 09:05 AM
thanks very much both options are working :)