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