AW: =WENN(Blatt1!Q8>20;Blatt1!Q4;"") in die...
22.07.2011 20:02:26
fcs
Hallo Markus,
hier ein Beispielmakro für so einen Datenvergleich/Transfer.
Gruß
Franz
Sub AuswertenZeile8()
Dim wksDaten As Worksheet, Spalte As Long, Wert
Dim wbZiel As Workbook, wksZiel As Worksheet, ZeileZiel As Long
'Tabelle mit den zu durchsuchenden Daten
Set wksDaten = ActiveWorkbook.Worksheets("Tabelle1")
'Namen/Objekte für Zieldatei/Tabelle
Const sVerzeichnis = "C:\Public\Users\Test"
Const sDatei = "ZielDatei.xls"
Set wbZiel = Workbooks.Open(Filename:=sVerzeichnis & Application.PathSeparator & sDatei)
Set wksZiel = wbZiel.Worksheets("Tabelle2")
With wksZiel
'Nächste frei Zeile ohne Daten in Spalte D (4)
ZeileZiel = .Cells(.Rows.Count, 4).End(xlUp).Row
If ZeileZiel = 1 And IsEmpty(.Cells(1, 4)) Then
ZeileZiel = 1
Else
ZeileZiel = ZeileZiel + 1
End If
End With
With wksDaten
'Zeile 8 in Datentabelle ab Spalte Q durchsuchen und vergleichen
Spalte = .Range("Q1").Column
Do Until .Cells(8, Spalte) = ""
If .Cells(8, Spalte) > 20 Then
'Wert aus Zeile 4 Zeilen oberhalb auslesen
Wert = .Cells(8, Spalte).Offset(-4, 0).Value
'Wert in Zieltabelle in SPalte D (4) eintragen
wksZiel.Cells(ZeileZiel, 4).Value = Wert
ZeileZiel = ZeileZiel + 1
End If
Spalte = Spalte + 1
Loop
End With
'Zieldatei wieder schliessen
wbZiel.Save
wbZiel.Close
'Objektvariablen aufräumen
Set wksDaten = Nothing
Set wbZiel = Nothing: Set wksZiel = Nothing
End Sub