Ich brauche mal wieder Hilfe. Ich habe ein Makro welches ein Verezichnis ausliest und mir jede Datei in dem Verzeichniss öffnet, die Tabellenblattnamen und diverse Daten aus den Tabellenblättern kopiert und diese werden in einer anderen Datei eingefügt. Das funktioniert, dank Ramses Hilfe (noch mal besten Dank an Ihn von dieser Stelle) hervorragend. Jetzt ist aber das Problem, dass in einigen Zellen Formeln stehen. Diese werden jetzt kopiert und eingefügt. Ich benötige aber in der Tabelle nicht die Formeln, sondern die Werte. Wie muss nun der Code verändert werden, damit nur Werte aber keine Formeln kopiert werden? Bin für jede Hilfe dankbar, denn ich bekomme es nicht hin. Nachfolgend das Makro.
Sub Daten_kopieren2()
Dim sFile As String, sPath As String
Dim qWb As Workbook, qWks As Worksheet, tarWks As Worksheet
Dim i As Integer, tarRow As Integer
Set tarWks = Workbooks("Inhalt.xls").Worksheets("Tabelle1")
Application.ScreenUpdating = False
Range("A2:H50").ClearContents
tarRow = tarWks.Cells(Rows.Count, 1).End(xlUp).Row + 3
Range("A" & tarRow & ":E" & tarRow).Select
With Selection.Interior
.ColorIndex = 36
End With
sPath = "E:\Daten"
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sFile = Dir(sPath & "*.xls")
Do While sFile <> ""
tarWks.Cells(tarRow, 2) = sFile
tarRow = tarRow + 1
If sFile <> ThisWorkbook.Name Then
Workbooks.Open sPath & sFile
Else
GoTo exit_loop
End If
Set qWb = ActiveWorkbook
For Each qWks In qWb.Worksheets
tarWks.Cells(tarRow, 1) = qWks.Name
'liest aus sFile J4
qWks.Cells(5, 10).Copy _
Destination:=tarWks.Cells(tarRow, 2)
'liest aus sFile J5
qWks.Cells(4, 10).Copy _
Destination:=tarWks.Cells(tarRow, 3)
'liest aus sFile P2
qWks.Cells(2, 16).Copy _
Destination:=tarWks.Cells(Cells(tarRow, 4).Row, 4)
'liest aus sFile P3
qWks.Cells(3, 16).Copy _
Destination:=tarWks.Cells(Cells(tarRow, 5).Row, 5)
tarRow = tarRow + 1
Next
qWb.Close False
exit_loop:
'tarRow = tarRow + 1
Range("A" & tarRow & ":E" & tarRow).Select
With Selection.Interior
.ColorIndex = 36
End With
sFile = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Danke Euch schon mal für die hilfe,
Oliver