Kopieren zw. Word und Excel
16.12.2003 12:05:33
MarkusKl
ich stehe vor einem kleinen Problem. Eine Excel Tabelle ist in mein Word Dokument eingebettet und hier werden verschiedene ArtikelNr eingegeben, die dann später mit einer Excel Tabelle abgeglichen werden sollen.
Da ich bisher noch nie zwischen Word und Excel ein Makro habe laufen lassen komme ich jetzt leider nicht weiter. Beide dateien liegen im gleichen Verzeichnis, doch ich bekomme gleich die Fehlermeldung "Es ist keine Testdatei geöffnet!" Es kann auch daran liegen dass ich das Word Dokument im Makro nicht richtig bezeichnet habe, da ich hier keine passende Hilfe gefunden habe.
Hoffentlich kann mir jemand weiterhelfen wo mein Fehler liegt.
Besten Dank
Markus
Sub Find_ArtNr_Beschr()
' Makro soll anhand der eingegebenen ArtikelNr die beschreibung
' und andere dazugehörige Werte finden.
Dim wkb As Workbook
Dim wkb2 As Workbook
Dim wks As Worksheet
'Dim rng As Range
On Error Resume Next
Set wkb = Workbooks("Test.xls")
Set wkb2 = Workbooks("Rechnungstemplate Maxdata.doc")
If Err > o Or wkb Is Nothing Then
Beep
MsgBox _
prompt:="Es ist keine Testdatei geöffnet!"
Exit Sub
End If
Set wks = wkb.Worksheets("Tabelle1")
If Err > o Or wks Is Nothing Then
Beep
MsgBox _
prompt:="Die Testdatei enthält das Zielblatt nicht!"
Exit Sub
End If
' Worddoc Tabelle 1 unabhängig vom Namen aktivieren
wkb2.Sheets(1).Activate
' Zählt die Anzahl der Zeilen
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
' Vergleiche Tabelle 1 Spalte 1 Reihe i mit ...
For i = 1 To lastrow
Wert = Cells(i, 1).Value
' ... Tabelle 2 Spalte 1 (komplett)
With wkb.Sheets(1).Columns(1)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlPart)
If Not C Is Nothing Then
Beschr = C(1, 2)
St_Pr = C(1, 6)
Cells(i, 1) = Beschr
Cells(i, 3) = St_Pr
End If
End With
Next i
End Sub