Copy Values if name of sheets in two different workbooks are equal

Hello everybody,

I have the following problem. The loop in the VBA code shown below works fine besides the fact that EXCEL copies cells from the destination workbook (wbTarget) instead of the ones from the source workbook (ThisWorkbook), as I wanted it to be. I thought I would overcome this problem with the With Command, but unfortunately this does not work and I have no furhter idea how to solve this problem. Any help is appreciated, thank you in advance.

Code:

---

Option Explicit

Sub Import_Basisdatei()
    Dim strPath As String, strDataName As String
    Dim ws As Worksheet
    Dim wbSource As Workbook
    Dim wbTarget As Workbook
    Dim i As Integer, ws_count As Integer
    Application.AskToUpdateLinks = False
    Application.AutomationSecurity = msoAutomationSecurityLow
    Application.ScreenUpdating = False
    strPath = ThisWorkbook.Worksheets("Menu").Range("C52") 'Pfad Zieldatei
    strDataName = ThisWorkbook.Worksheets("Menu").Range("C53") 'Name Zieldatei
    Set wbTarget = Application.Workbooks.Open(strPath & strDataName, UpdateLinks:=0, ReadOnly:=False)
    ws_count = ActiveWorkbook.Worksheets.Count
    With ThisWorkbook
        For Each ws In Worksheets
            For i = 1 To ws_count
                If ws.Name = wbTarget.Worksheets(i).Range("N1").Value Then
                    ws.Range(ws.Cells(25, 3), ws.Cells(25, 17)).Copy
                    wbTarget.Worksheets(i).Range("C23").PasteSpecial Paste:=xlPasteValues
                End If
            Next i
        Next ws
    End With
    Application.AskToUpdateLinks = True
    Application.AutomationSecurity = msoAutomationSecurityByUI
    Application.ScreenUpdating = True
End Sub

---

kind regards
thank you in advance

1. I added CODE tags around your macro you can use the [#] icon to insert them and then paste your macro between

2. Not tested but I guessed -- see the comments

3. Also added an alternate version -- matter of style and personal choice

Code:

---

Option Explicit

Sub Import_Basisdatei()
    Dim strPath As String, strDataName As String
    Dim ws As Worksheet
    Dim wbSource As Workbook          ' Not used
    Dim wbTarget As Workbook
    Dim i As Long, ws_count As Long  '  Use Long
    Application.AskToUpdateLinks = False
    Application.AutomationSecurity = msoAutomationSecurityLow
    Application.ScreenUpdating = False
    strPath = ThisWorkbook.Worksheets("Menu").Range("C52") 'Pfad Zieldatei
    strDataName = ThisWorkbook.Worksheets("Menu").Range("C53") 'Name Zieldatei
    Set wbTarget = Application.Workbooks.Open(strPath & strDataName, UpdateLinks:=0, ReadOnly:=False)
    ws_count = ActiveWorkbook.Worksheets.Count  '  This is wbTarget ??
    With ThisWorkbook
        For Each ws In .Worksheets      '  Add the dot so that Worksheets's parent is ThisWorkbook
            For i = 1 To ws_count
                If ws.Name = wbTarget.Worksheets(i).Range("N1").Value Then
                    ws.Range(ws.Cells(25, 3), ws.Cells(25, 17)).Copy
                    wbTarget.Worksheets(i).Range("C23").PasteSpecial Paste:=xlPasteValues
                End If
            Next i
        Next ws
    End With
    Application.AskToUpdateLinks = True
    Application.AutomationSecurity = msoAutomationSecurityByUI
    Application.ScreenUpdating = True
End Sub

---

Alternate

Code:

---

Sub Import_Basisdatei_Alt()
    Dim strPath As String, strDataName As String
    Dim ws As Worksheet
    Dim wbTarget As Workbook
    Dim i As Long
    With Application
        .AskToUpdateLinks = False
        .AutomationSecurity = msoAutomationSecurityLow
        .ScreenUpdating = False
    End With
    strPath = ThisWorkbook.Worksheets("Menu").Range("C52") 'Pfad Zieldatei
    strDataName = ThisWorkbook.Worksheets("Menu").Range("C53") 'Name Zieldatei
    Set wbTarget = Application.Workbooks.Open(strPath & strDataName, UpdateLinks:=0, ReadOnly:=False)
    For Each ws In ThisWorkbook.Worksheets
        For i = 1 To wbTarget.Worksheets.Count
            If ws.Name = wbTarget.Worksheets(i).Range("N1").Value Then
                ws.Range(ws.Cells(25, 3), ws.Cells(25, 17)).Copy
                wbTarget.Worksheets(i).Range("C23").PasteSpecial Paste:=xlPasteValues
            End If
        Next i
    Next ws
    With Application
        .AskToUpdateLinks = True
        .AutomationSecurity = msoAutomationSecurityByUI
        .ScreenUpdating = True
    End With
End Sub

---