Fabbby-San
04-19-2018, 01:17 AM
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
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