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

[mduff]

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

[VBA]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[/VBA]

[GTO]

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]

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



[VBA] 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
[/VBA]


Any adtional help will be much apriceated

thanks!!!!

[mohanvijay]

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]

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



[vba] 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
[/vba]

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]

thanks very much both options are working