PDA

View Full Version : Copy Values if name of sheets in two different workbooks are equal



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

Paul_Hossler
04-19-2018, 07:02 PM
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