Zellinhalt von zwei Mappen zuweisen
27.07.2020 14:26:44
zwei
ich habe folgendes Problem.
In einem Workbook1 (111.xlsm) habe ich Bezeichnungen in einer Zeile. In einem zweiten Workbook2 (test.xlsm) stehen diese Bezeichnung untereinander in Spalte 3 und deren Beschreibung in Spalte 4 der selben Zeile.
Nun möchte ich nach den Bezeichnungen aus Workbook1 in Workbook2 suchen und die entsprechende Beschreibung unter die Bezeichnung schreiben. Workbook2 soll im Hintergrund geöffnet und geschlossen werden.
Sub Programm()
Dim strSearch As String
Dim i As Integer
Dim j As Integer
Windows("111.xlsm").Activate
'Letzte Spalte finden, um Suche zu begrenzen
letztespalte = Worksheets("Tabelle1").Cells(1, 256).End(xlToLeft).Column
Application.ScreenUpdating = False
Workbooks.Add
ActiveWindow.Visible = False
Workbooks.Open Filename:="C:\Desktop\Excel VBA\test.xlsm", UpdateLinks:=3, Notify:=False
Windows("test.xlsm").Activate
EndeTB2 = ActiveWorkbook.Worksheets("Tabelle2").Cells(Rows.Count, 3).End(xlUp).Row
Windows("111.xlsm").Activate
'Anfang der ersten Zählschleife
For j = 4 To letztespalte
strSearch = Cells(1, j) 'Suchwort
Windows("test.xlsm").Activate
For i = 1 To EndeTB2
' Wenn Bezeichnung in Spalte gefunden, dann...
If ActiveWorkbook.Worksheets("Tabelle2").Cells(i, 3) = strSearch Then
Workbooks("111.xlsm").Worksheets("Tabelle1").Cells(2, j) = Workbooks("test. _
xlsm").Worksheets("Tabelle2").Cells(i, 4)
End If
Next i
Windows("111.xlsm").Activate
Next j
Windows("test.xlsm").Close
Application.ScreenUpdating = True
End Sub
In einem ersten Schritt habe ich mir den Code innerhalb eines Workbooks mit unterschiedlichen Sheets geschrieben. Das hat auch funktioniert. Die Erweiterung auf zwei Workbooks klappt jetzt nicht. Er bleibt mit Laufzeitfehler 9 hängen bei
Workbooks("111.xlsm").Worksheets("Tabelle1").Cells(2, j) = Workbooks("test.xlsm").Worksheets("Tabelle2").Cells(i, 4)
Sheets("Tabelle1").Cells(2, j) = Sheets("Tabelle2").Cells(i, 4)
Viele Grüße
Torsten