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

[Fabbby-San]

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.


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

[Paul_Hossler]

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



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



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