Copy cell value from one worksheet to matching worksheet in another workbook

[rech]

I have 2 workbooks: OLD and NEW. They each have over 100 sheets
(most sheets are the same but some are different). I want to set the
value of cell C7 in the NEW workbook to the value from cell G40 in the
OLD workbook. I'd like open both workbooks then run a macro that runs
through every sheet in NEW and captures the sheet name then matches it
to the same sheet in the OLD workbook, copies the value from G40, then
pastes it into the NEW workbook C7.

Thanks so much for any help!!

 

[Dave Peterson]

Option Explicit
Sub testme()

Dim OldWkbk As Workbook
Dim NewWkbk As Workbook
Dim oWS As Worksheet
Dim nWS As Worksheet

Set OldWkbk = Workbooks("youroldworkbooknamehere.xls")
Set NewWkbk = Workbooks("yournewworkbooknamehere.xls")

For Each oWS In OldWkbk.Worksheets
Set nWS = Nothing
On Error Resume Next
Set nWS = NewWkbk.Worksheets(oWS.Name)
On Error GoTo 0

If nWS Is Nothing Then
MsgBox oWS.Name & " doesn't exist in " & NewWkbk.Name
Else
nWS.Range("C7").Value = oWS.Range("g40").Value
End If

Next oWS

End Sub


Untested, but it did compile.

 

[rech]

Option Explicit
Sub testme()

     Dim OldWkbk As Workbook
     Dim NewWkbk As Workbook
     Dim oWS As Worksheet
     Dim nWS As Worksheet

     Set OldWkbk = Workbooks("youroldworkbooknamehere.xls")
     Set NewWkbk = Workbooks("yournewworkbooknamehere.xls")

     For Each oWS In OldWkbk.Worksheets
       Set nWS = Nothing
       On Error Resume Next
       Set nWS = NewWkbk.Worksheets(oWS.Name)
       On Error GoTo 0

       If nWS Is Nothing Then
          MsgBox oWS.Name & " doesn't exist in " & NewWkbk.Name
       Else
          nWS.Range("C7").Value = oWS.Range("g40").Value
       End If

     Next oWS

End Sub

Untested, but it did compile.

Dave, You're my hero! This worked beautifully!! Is there any way to
exclude one or more sheets from this macro. In the OLD and NEW
workbooks, I have a Summary sheet and I do not want the macro to apply
to this sheet.

 

[Dave Peterson]

One way:

Option Explicit
Sub testme()

Dim OldWkbk As Workbook
Dim NewWkbk As Workbook
Dim oWS As Worksheet
Dim nWS As Worksheet

Set OldWkbk = Workbooks("youroldworkbooknamehere.xls")
Set NewWkbk = Workbooks("yournewworkbooknamehere.xls")

For Each oWS In OldWkbk.Worksheets
Select Case UCase(oWS.Name)
Case Is = UCase("Summary"), _
UCase("anyother"), _
UCase("another")
'do nothing
Case Else
Set nWS = Nothing
On Error Resume Next
Set nWS = NewWkbk.Worksheets(oWS.Name)
On Error GoTo 0

If nWS Is Nothing Then
MsgBox oWS.Name & " doesn't exist in " & NewWkbk.Name
Else
nWS.Range("C7").Value = oWS.Range("g40").Value
End If
End Select

Next oWS

End Sub

(Still untested.)

 

[rech]

One way:

Option Explicit
Sub testme()

     Dim OldWkbk As Workbook
     Dim NewWkbk As Workbook
     Dim oWS As Worksheet
     Dim nWS As Worksheet

     Set OldWkbk = Workbooks("youroldworkbooknamehere.xls")
     Set NewWkbk = Workbooks("yournewworkbooknamehere.xls")

     For Each oWS In OldWkbk.Worksheets
       Select Case UCase(oWS.Name)
         Case Is = UCase("Summary"), _
                   UCase("anyother"), _
                   UCase("another")
           'do nothing
         Case Else
           Set nWS = Nothing
           On Error Resume Next
           Set nWS = NewWkbk.Worksheets(oWS.Name)
           On Error GoTo 0

           If nWS Is Nothing Then
              MsgBox oWS.Name & " doesn't exist in " & NewWkbk.Name
           Else
              nWS.Range("C7").Value = oWS.Range("g40").Value
           End If
         End Select

     Next oWS

End Sub

(Still untested.)

Wonderful!!! Worked perfectly! I appreciate this, Dave!!