Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
420to424
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
420to424
420to424
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Nur Werte kopieren, keine Formeln?

Nur Werte kopieren, keine Formeln?
Oliver
Moin an alle.
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Nur Werte kopieren, keine Formeln?
01.05.2004 08:18:37
Nepumuk
Hallo Oliver,
so geht's:
'liest aus sFile J4
tarWks.Cells(tarRow, 2) = Wks.Cells(5, 10).Value
'liest aus sFile J5
tarWks.Cells(tarRow, 3) = qWks.Cells(4, 10).Value
'liest aus sFile P2
tarWks.Cells(Cells(tarRow, 4).Row, 4) = qWks.Cells(2, 16).Value
'liest aus sFile P3
tarWks.Cells(Cells(tarRow, 5).Row, 5) = qWks.Cells(3, 16).Value
Gruß
Nepumuk
AW: Nur Werte kopieren, keine Formeln?
WernerB.
Hallo Oliver,
wenn Du die Formate mitkopieren willst, dann so:
Option Explicit

Sub Daten_kopieren2A()
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
tarWks.Cells(tarRow, 2).PasteSpecial Paste:=xlFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
tarWks.Cells(tarRow, 2).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'liest aus sFile J5
qWks.Cells(4, 10).Copy
tarWks.Cells(tarRow, 3).PasteSpecial Paste:=xlFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
tarWks.Cells(tarRow, 3).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'liest aus sFile P2
qWks.Cells(2, 16).Copy
tarWks.Cells(Cells(tarRow, 4).Row, 4).PasteSpecial Paste:=xlFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
tarWks.Cells(Cells(tarRow, 4).Row, 4).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'liest aus sFile P3
qWks.Cells(3, 16).Copy
tarWks.Cells(Cells(tarRow, 5).Row, 5).PasteSpecial Paste:=xlFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
tarWks.Cells(Cells(tarRow, 5).Row, 5).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
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

Viel Erfolg wünscht
WernerB.
Anzeige
Danke funktioniert!
Oliver
Hi,
danke Euch beiden, funktioniert.
Grus,
Oliver

319 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige