Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 12:38:40
Formeländerung durch Wechsel von Excel 2021 auf 2019
24.04.2024 12:31:18
Excel - Sverweis mit Wenn-Abfrage kombinieren
24.04.2024 12:16:26
Name von aktuellem VBA-Modul ausgeben
24.04.2024 12:07:15
Werte einer Liste vergleichen und markieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1196to1200
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1196to1200
1196to1200
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA/Makro - Werte statt Formeln kopieren

VBA/Makro - Werte statt Formeln kopieren
Pierre
Hallo zusammen!
Bin kein VBA-Experte und habe mir mühselig durch googlen ein Makro zusammengestellt.
Grundidee:
Ich habe viele Dateien, die nach dem gleichen Schema F errechnet wurden, sprich alle Dateien sind gleich aufgebaut! Nun möchte ich die wichtigen errechneten Werte (ca. 50 pro Datei) in eine Datei ziehen, um eine Gesamtübersicht zu bekommen.
Das gebastelte Makro:
Das Makro öffnet einzeln alle Dateien, die in einem Ordner sind, und kopiert gezielt die Zellen die ich brauche zeilenmäßig und automatisch untereinander. Eigentlich perfekt!
Problem:
Beim Kopieren überträgt das Makro auch Formeln und Formate. Das die Formate mit übertragen werden, da kann ich noch mit leben, aber ich möchte nur die Werte aus den einzelnen Zellen haben und keine Formeln!
Kann mir da bitte jemand schnell weiterhelfen? Versuche mit ".PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _ Transpose:=False" irgendwo einzufügen sind bei mir leider gescheitert..
Anbei ein Ausschnitt mit zwei Zellenkopien vom Makro! Vielen Dank schonmal!
If DateiName ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien) 'öffnet die Datei
If zaehler = False Then
zeile = 4
Else
zeile = ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
Workbooks(DateiName).Sheets("Tabelle1").Range("E1").Copy ThisWorkbook.Sheets("Tabelle1").Range("A" & zeile & ":A" & zeile) 'Geschwindigkeit
Workbooks(DateiName).Sheets("Tabelle1").Range("E2").Copy ThisWorkbook.Sheets("Tabelle1").Range("B" & zeile & ":B" & zeile) 'Tonnen
zaehler = True
Workbooks(DateiName).Close SaveChanges:=True 'schließt die Datei
End If
AW: VBA/Makro - Werte statt Formeln kopieren
07.02.2011 17:03:58
Josef

Hallo Pierre,
With ThisWorkbook.Sheets("Tabelle1")
  .Cells(zeile, 1) = Workbooks(DateiName).Sheets("Tabelle1").Range("E1").Value
  .Cells(zeile, 2) = Workbooks(DateiName).Sheets("Tabelle1").Range("E2").Value
End With


Gruß Sepp

Anzeige
AW: VBA/Makro - Werte statt Formeln kopieren
07.02.2011 17:22:06
Pierre
Hallo Josef,
erstmal vielen Dank für die schnelle Antwort. Aber das Makro überschreibt jetzt die erste Zeile immer wieder.. Und in den original Dateien sind die "wichtigen Zellen" aufeinmal leer.. Ich Idiot hab auch die Dateien nicht kopiert. Das Ganze jetzt rückgängig zu machen geht wohl nicht, oder?
Aber das Problem ist noch nicht ganz gelöst..
AW: VBA/Makro - Werte statt Formeln kopieren
07.02.2011 17:27:19
Josef

Hallo Pierre,
also mein Code löscht bestimmt keine Zellen, er macht im Prinzip das selbe wie deiner, nur das nicht kopiert wird, sondern direkt die Werte in die Zellen geschrieben werden.
"Aber das Makro überschreibt jetzt die erste Zeile immer wieder"
etwas anderes ist aus deinem Codeschnipsel auch nicht zu erwarten/ersehen.

Gruß Sepp

Anzeige
AW: VBA/Makro - Werte statt Formeln kopieren
07.02.2011 17:35:39
Pierre
Keine Ahnung wie das Ganze entstanden ist, aber da fehlen jetzt Werte.. Aber nicht sooo schlimm, das bekomme ich wieder hin..
Anbei der Ganze Code:
Sub Einfügen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
Dim zaehler As Boolean
With Application.FileSearch
.NewSearch
.LookIn = "V:\pierre 'Pfad für Ordner
.SearchSubFolders = True
.Filename = "*.xls" 'es werden nur xls-Dateien aus dem ordner verwendet
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien) 'öffnet die Datei
If zaehler = False Then
zeile = 4
Else
zeile = ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
Workbooks(DateiName).Sheets("Tabelle1").Range("E1").Copy ThisWorkbook.Sheets("Tabelle1").Range("A" & zeile & ":A" & zeile) 'Kunde
Workbooks(DateiName).Sheets("Tabelle1").Range("E2").Copy ThisWorkbook.Sheets("Tabelle1").Range("B" & zeile & ":B" & zeile) 'Bauteilbezeichnung
Workbooks(DateiName).Sheets("Tabelle1").Range("E3").Copy ThisWorkbook.Sheets("Tabelle1").Range("C" & zeile & ":C" & zeile) 'Ident
Workbooks(DateiName).Sheets("Tabelle1").Range("B6").Copy ThisWorkbook.Sheets("Tabelle1").Range("D" & zeile & ":D" & zeile) 'Liefermenge jährlich
Workbooks(DateiName).Sheets("Tabelle1").Range("B18").Copy ThisWorkbook.Sheets("Tabelle1").Range("E" & zeile & ":E" & zeile) 'max. Coilgewicht
Workbooks(DateiName).Sheets("Tabelle1").Range("B20").Copy ThisWorkbook.Sheets("Tabelle1").Range("F" & zeile & ":F" & zeile) 'i.O.-Platinen pro Coil
Workbooks(DateiName).Sheets("Tabelle1").Range("B23").Copy ThisWorkbook.Sheets("Tabelle1").Range("G" & zeile & ":G" & zeile) 'Ladungsträgerart
Workbooks(DateiName).Sheets("Tabelle1").Range("B37").Copy ThisWorkbook.Sheets("Tabelle1").Range("H" & zeile & ":H" & zeile) 'Platinen pro LT
Workbooks(DateiName).Sheets("Tabelle1").Range("B39").Copy ThisWorkbook.Sheets("Tabelle1").Range("I" & zeile & ":I" & zeile) 'Bruttogewicht LT
Workbooks(DateiName).Sheets("Tabelle1").Range("E5").Copy ThisWorkbook.Sheets("Tabelle1").Range("J" & zeile & ":J" & zeile) 'Arbeitsstation
Workbooks(DateiName).Sheets("Tabelle1").Range("E9").Copy ThisWorkbook.Sheets("Tabelle1").Range("K" & zeile & ":K" & zeile) 'Platinen pro Hub
Workbooks(DateiName).Sheets("Tabelle1").Range("E10").Copy ThisWorkbook.Sheets("Tabelle1").Range("L" & zeile & ":L" & zeile) 'Hub je Minute
Workbooks(DateiName).Sheets("Tabelle1").Range("E23").Copy ThisWorkbook.Sheets("Tabelle1").Range("M" & zeile & ":M" & zeile) 'LT pro LKW
Workbooks(DateiName).Sheets("Tabelle1").Range("E24").Copy ThisWorkbook.Sheets("Tabelle1").Range("N" & zeile & ":N" & zeile) 'Platinen pro LKW
Workbooks(DateiName).Sheets("Tabelle1").Range("B34").Copy ThisWorkbook.Sheets("Tabelle1").Range("O" & zeile & ":O" & zeile) 'Anzahl LT vom Kunden
Workbooks(DateiName).Sheets("Tabelle1").Range("F28").Copy ThisWorkbook.Sheets("Tabelle1").Range("P" & zeile & ":P" & zeile) 'SB
Workbooks(DateiName).Sheets("Tabelle1").Range("I28").Copy ThisWorkbook.Sheets("Tabelle1").Range("Q" & zeile & ":Q" & zeile) 'Lagerfläche SB
Workbooks(DateiName).Sheets("Tabelle1").Range("I9").Copy ThisWorkbook.Sheets("Tabelle1").Range("R" & zeile & ":R" & zeile) 'Rüstvorgänge Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I10").Copy ThisWorkbook.Sheets("Tabelle1").Range("S" & zeile & ":S" & zeile) 'Coils pr Los Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I11").Copy ThisWorkbook.Sheets("Tabelle1").Range("T" & zeile & ":T" & zeile) 'Stückzahl pro Los Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I12").Copy ThisWorkbook.Sheets("Tabelle1").Range("U" & zeile & ":U" & zeile) 'LT pro Los Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I14").Copy ThisWorkbook.Sheets("Tabelle1").Range("V" & zeile & ":V" & zeile) 'LT gesamt Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I22").Copy ThisWorkbook.Sheets("Tabelle1").Range("W" & zeile & ":W" & zeile) 'Hübe je Los Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I25").Copy ThisWorkbook.Sheets("Tabelle1").Range("X" & zeile & ":X" & zeile) 'Poduktionsdauer Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I16").Copy ThisWorkbook.Sheets("Tabelle1").Range("Y" & zeile & ":Y" & zeile) 'Lagerkosten Lose Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I17").Copy ThisWorkbook.Sheets("Tabelle1").Range("Z" & zeile & ":Z" & zeile) 'Lagerkosten SB Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I18").Copy ThisWorkbook.Sheets("Tabelle1").Range("AA" & zeile & ":AA" & zeile) 'Rüstkosten Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I19").Copy ThisWorkbook.Sheets("Tabelle1").Range("AB" & zeile & ":AB" & zeile) 'LT-Kosten Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I20").Copy ThisWorkbook.Sheets("Tabelle1").Range("AC" & zeile & ":AC" & zeile) 'Gesamtkosten Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I34").Copy ThisWorkbook.Sheets("Tabelle1").Range("AD" & zeile & ":AD" & zeile) 'geschlossene Fläche Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("I37").Copy ThisWorkbook.Sheets("Tabelle1").Range("AE" & zeile & ":AE" & zeile) 'überdachte Fläche Gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J9").Copy ThisWorkbook.Sheets("Tabelle1").Range("AF" & zeile & ":AF" & zeile) 'Rüstvorgänge optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J10").Copy ThisWorkbook.Sheets("Tabelle1").Range("AG" & zeile & ":AG" & zeile) 'Coils pr Los optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J11").Copy ThisWorkbook.Sheets("Tabelle1").Range("AH" & zeile & ":AH" & zeile) 'Stückzahl pro Losoptimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J12").Copy ThisWorkbook.Sheets("Tabelle1").Range("AI" & zeile & ":AI" & zeile) 'LT pro Los optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J14").Copy ThisWorkbook.Sheets("Tabelle1").Range("AJ" & zeile & ":AJ" & zeile) 'LT gesamt optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J22").Copy ThisWorkbook.Sheets("Tabelle1").Range("AK" & zeile & ":AK" & zeile) 'Hübe je Los optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J25").Copy ThisWorkbook.Sheets("Tabelle1").Range("AL" & zeile & ":AL" & zeile) 'Poduktionsdauer optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J16").Copy ThisWorkbook.Sheets("Tabelle1").Range("AM" & zeile & ":AM" & zeile) 'Lagerkosten Lose optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J17").Copy ThisWorkbook.Sheets("Tabelle1").Range("AN" & zeile & ":AN" & zeile) 'Lagerkosten SB optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J18").Copy ThisWorkbook.Sheets("Tabelle1").Range("AO" & zeile & ":AO" & zeile) 'Rüstkosten Mubea optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J19").Copy ThisWorkbook.Sheets("Tabelle1").Range("AP" & zeile & ":AP" & zeile) 'LT-Kosten optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J20").Copy ThisWorkbook.Sheets("Tabelle1").Range("AQ" & zeile & ":AQ" & zeile) 'Gesamtkosten optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J34").Copy ThisWorkbook.Sheets("Tabelle1").Range("AR" & zeile & ":AR" & zeile) 'geschlossene Fläche optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("J37").Copy ThisWorkbook.Sheets("Tabelle1").Range("AS" & zeile & ":AS" & zeile) 'überdachte Fläche optimal
Workbooks(DateiName).Sheets("Tabelle1").Range("K9").Copy ThisWorkbook.Sheets("Tabelle1").Range("AT" & zeile & ":AT" & zeile) 'Rüstvorgänge max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K10").Copy ThisWorkbook.Sheets("Tabelle1").Range("AU" & zeile & ":AU" & zeile) 'Coils pr Los max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K11").Copy ThisWorkbook.Sheets("Tabelle1").Range("AV" & zeile & ":AV" & zeile) 'Stückzahl pro Los max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K12").Copy ThisWorkbook.Sheets("Tabelle1").Range("AW" & zeile & ":AW" & zeile) 'LT pro Los max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K14").Copy ThisWorkbook.Sheets("Tabelle1").Range("AX" & zeile & ":AX" & zeile) 'LT gesamt max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K22").Copy ThisWorkbook.Sheets("Tabelle1").Range("AY" & zeile & ":AX" & zeile) 'Hübe je Los max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K25").Copy ThisWorkbook.Sheets("Tabelle1").Range("AZ" & zeile & ":AZ" & zeile) 'Poduktionsdauer max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K16").Copy ThisWorkbook.Sheets("Tabelle1").Range("BA" & zeile & ":BA" & zeile) 'Lagerkosten Lose max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K17").Copy ThisWorkbook.Sheets("Tabelle1").Range("BB" & zeile & ":BB" & zeile) 'Lagerkosten SB max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K18").Copy ThisWorkbook.Sheets("Tabelle1").Range("BC" & zeile & ":BC" & zeile) 'Rüstkosten max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K19").Copy ThisWorkbook.Sheets("Tabelle1").Range("BD" & zeile & ":BD" & zeile) 'LT-Kosten Mubea max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K20").Copy ThisWorkbook.Sheets("Tabelle1").Range("BE" & zeile & ":BE" & zeile) 'Gesamtkosten max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K34").Copy ThisWorkbook.Sheets("Tabelle1").Range("BF" & zeile & ":BF" & zeile) 'geschlossene Fläche max. Erweiterung
Workbooks(DateiName).Sheets("Tabelle1").Range("K37").Copy ThisWorkbook.Sheets("Tabelle1").Range("BG" & zeile & ":BG" & zeile) 'überdachte Fläche max. Erweiterung
zaehler = True
Workbooks(DateiName).Close SaveChanges:=True 'schließt die Datei
End If
Next Dateien
End If
End With
Call EventsOn
End Sub 
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Anzeige
AW: VBA/Makro - Werte statt Formeln kopieren
07.02.2011 18:06:00
Josef

Hallo Pierre,
probier mal.
Sub Einfügen()
  Dim objWb As Workbook, objSh As Worksheet
  Dim intCount As Integer, lngRow As Long
  
  On Error GoTo ErrExit
  Call EventsOff
  
  lngRow = Application.Max(4, ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1)
  
  With Application.FileSearch
    .NewSearch
    .LookIn = "V:\pierre 'Pfad für Ordner"
    .SearchSubFolders = True
    .Filename = "*.xls" 'es werden nur xls-intCount aus dem ordner verwendet
    If .Execute() > 0 Then
      For intCount = 1 To .FoundFiles.Count
        If .FoundFiles(intCount) <> ThisWorkbook.FullName Then
          Set objWb = Workbooks.Open(.FoundFiles(intCount)) 'öffnet die Datei
          Set objSh = objWb.Sheets("Tabelle1")
          
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 1) = objSh.Range("E1").Value 'Kunde
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 2) = objSh.Range("E2").Value 'Bauteilbezeichnung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 3) = objSh.Range("E3").Value 'Ident
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 4) = objSh.Range("B6").Value 'Liefermenge jährlich
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 5) = objSh.Range("B18").Value 'max. Coilgewicht
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 6) = objSh.Range("B20").Value 'i.O.-Platinen pro Coil
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 7) = objSh.Range("B23").Value 'Ladungsträgerart
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 8) = objSh.Range("B37").Value 'Platinen pro LT
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 9) = objSh.Range("B39").Value 'Bruttogewicht LT
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 10) = objSh.Range("E5").Value 'Arbeitsstation
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 11) = objSh.Range("E9").Value 'Platinen pro Hub
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 12) = objSh.Range("E10").Value 'Hub je Minute
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 13) = objSh.Range("E23").Value 'LT pro LKW
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 14) = objSh.Range("E24").Value 'Platinen pro LKW
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 15) = objSh.Range("B34").Value 'Anzahl LT vom Kunden
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 16) = objSh.Range("F28").Value 'SB
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 17) = objSh.Range("I28").Value 'Lagerfläche SB
          
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 18) = objSh.Range("I9").Value 'Rüstvorgänge Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 19) = objSh.Range("I10").Value 'Coils pr Los Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 20) = objSh.Range("I11").Value 'Stückzahl pro Los Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 21) = objSh.Range("I12").Value 'LT pro Los Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 22) = objSh.Range("I14").Value 'LT gesamt Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 23) = objSh.Range("I22").Value 'Hübe je Los Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 24) = objSh.Range("I25").Value 'Poduktionsdauer Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 25) = objSh.Range("I16").Value 'Lagerkosten Lose Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 26) = objSh.Range("I17").Value 'Lagerkosten SB Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 27) = objSh.Range("I18").Value 'Rüstkosten Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 28) = objSh.Range("I19").Value 'LT-Kosten Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 29) = objSh.Range("I20").Value 'Gesamtkosten Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 30) = objSh.Range("I34").Value 'geschlossene Fläche Gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 31) = objSh.Range("I37").Value 'überdachte Fläche Gesamt optimal
          
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 32) = objSh.Range("J9").Value 'Rüstvorgänge optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 33) = objSh.Range("J10").Value 'Coils pr Los optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 34) = objSh.Range("J11").Value 'Stückzahl pro Losoptimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 35) = objSh.Range("J12").Value 'LT pro Los optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 36) = objSh.Range("J14").Value 'LT gesamt optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 37) = objSh.Range("J22").Value 'Hübe je Los optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 38) = objSh.Range("J25").Value 'Poduktionsdauer optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 39) = objSh.Range("J16").Value 'Lagerkosten Lose optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 40) = objSh.Range("J17").Value 'Lagerkosten SB optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 41) = objSh.Range("J18").Value 'Rüstkosten Mubea optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 42) = objSh.Range("J19").Value 'LT-Kosten optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 43) = objSh.Range("J20").Value 'Gesamtkosten optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 44) = objSh.Range("J34").Value 'geschlossene Fläche optimal
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 45) = objSh.Range("J37").Value 'überdachte Fläche optimal
          
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 46) = objSh.Range("K9").Value 'Rüstvorgänge max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 47) = objSh.Range("K10").Value 'Coils pr Los max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 48) = objSh.Range("K11").Value 'Stückzahl pro Los max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 49) = objSh.Range("K12").Value 'LT pro Los max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 50) = objSh.Range("K14").Value 'LT gesamt max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 51) = objSh.Range("K22").Value 'Hübe je Los max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 52) = objSh.Range("K25").Value 'Poduktionsdauer max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 53) = objSh.Range("K16").Value 'Lagerkosten Lose max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 54) = objSh.Range("K17").Value 'Lagerkosten SB max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 55) = objSh.Range("K18").Value 'Rüstkosten max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 56) = objSh.Range("K19").Value 'LT-Kosten Mubea max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 57) = objSh.Range("K20").Value 'Gesamtkosten max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 58) = objSh.Range("K34").Value 'geschlossene Fläche max. Erweiterung
          ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 59) = objSh.Range("K37").Value 'überdachte Fläche max. Erweiterung
          
          Set objSh = Nothing
          objWb.Close False 'schließt die Datei
          lngRow = lngRow + 1
        End If
      Next
    End If
  End With
  
  ErrExit:
  If Err.Number <> 0 Then
    MsgBox "Fehler:" & vbTab & Err.Number & vbLf & vbLf & Err.Description, vbExclamation, "Fehler"
  End If
  Call EventsOn
  
  Set objSh = Nothing
  Set objWb = Nothing
End Sub

Public Sub EventsOff()
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
  End With
End Sub
Public Sub EventsOn()
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
  End With
End Sub


Gruß Sepp

Anzeige
AW: VBA/Makro - Werte statt Formeln kopieren
07.02.2011 18:13:24
Pierre
Hut ab!!! :-)
Ich sitze schon den ganzen Tag dran.. Es funktioniert einwandfrei!!!
Vielen vielen Dank!!!
Schöne Grüße, Pierre!
und noch ein bisschen aufgeräumt
07.02.2011 19:20:04
Josef

Hallo Pierre,
so wir es noch übersichtlicher.

Sub Einfügen()
  Dim objWb As Workbook
  Dim intCount As Integer, lngRow As Long
  Dim vntC As Variant, lngCol As Long
  Const strCells As String = _
    "E1,E2,E3,B6,B18,B20,B23,B37,B39,E5,E9,E10,E23,E24,B34,F28,I28,I9,I10,I11,I12,I14,I22,I25,I16,I17,I18,I19,I20,I34,I37,J9,J10,J11,J12,J14,J22,J25,J16,J17,J18,J19,J20,J34,J37,K9,K10,K11,K12,K14,K22,K25,K16,K17,K18,K19,K20,K34,K37"
  
  On Error GoTo ErrExit
  Call EventsOff
  
  lngRow = Application.Max(4, ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1)
  
  vntC = Split(strCells, ",")
  
  With Application.FileSearch
    .NewSearch
    .LookIn = "V:\pierre 'Pfad für Ordner"
    .SearchSubFolders = True
    .Filename = "*.xls" 'es werden nur xls-intCount aus dem ordner verwendet
    If .Execute() > 0 Then
      For intCount = 1 To .FoundFiles.Count
        If .FoundFiles(intCount) <> ThisWorkbook.FullName Then
          Set objWb = Workbooks.Open(.FoundFiles(intCount)) 'öffnet die Datei
          
          For lngCol = 1 To UBound(vntC) + 1
            ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, lngCol) = objWb.Sheets("Tabelle1").Range(vntC(lngCol - 1)).Value
          Next
          
          objWb.Close False 'schließt die Datei
          lngRow = lngRow + 1
        End If
      Next
    End If
  End With
  
  ErrExit:
  If Err.Number <> 0 Then
    MsgBox "Fehler:" & vbTab & Err.Number & vbLf & vbLf & Err.Description, vbExclamation, "Fehler"
  End If
  Call EventsOn
  
  Set objWb = Nothing
End Sub

Public Sub EventsOff()
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
  End With
End Sub
Public Sub EventsOn()
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
  End With
End Sub


Gruß Sepp

Anzeige

306 Forumthreads zu ähnlichen Themen

Zellen kopieren (mit Formatierung)
Yves

Hallo zusammen,
ich möchte Daten von einem Tabellenblatt (Tabelle2) in ein anderes Tabellenblatt (Tabelle1) kopieren.
Habe dies bis anhin so gelöst:
sheets("Tabelle1").cells(1,1).value = sheets("Tabelle2").cells(5,1).value
Somit wurden einfach nur die Werte 'kopiert'. Nun würde...
08.08.2008 14:09:18
Thread-ID: 1000289
8 Beiträge
Anzeige
Spaltenwerte ausgewählter Tabellen kopieren
obelix-xxl

Hallo,
in mehreren Tabellen habe ich in der gleichen Spalte X11:X100 Summenwerte eingetragen.
Die Spaltenbeschriftung ist in der Zelle X10 und ist gleich dem Tabellennamen, z.B. -1.234.
Zur weiteren Verwendung möchte ich nur die Ergebnisse der markierten Tabellenblätter in eine neu...
07.09.2008 08:42:00
Thread-ID: 1007926
2 Beiträge
aus kompletter Mappe NUR WERTE kopieren
Lauren

Hallo zusammen,
das ist wohl etwas simples aber ich bin nicht dahintegekommen.
Ich will eine Kopie einer Excel-Mappe mit ca. 80 Tabellenblättern erstellen aber es sollen NUR DIE WERTE kopiert werden also ohne Formeln usw. nur die Werte.
Dann in allen Tabellenblättern in der Kopierte...
17.09.2008 11:04:00
Thread-ID: 1010287
5 Beiträge
Anzeige
VBA Zellen mit x kopieren aber nur bestimmte Zellen
balta

Hallo zusammen,
habe folgendes problem, undzwar sieht meine Tabelle so aus
__A____B______C______D_____E_______F_____G____H
1_x___alf___test1_________________1234___a____ist ein Auto
2_y________________Ulf____test2__________b____ist ein Krad
3
4
5
6_y_____________...
26.09.2008 23:48:47
Thread-ID: 1012775
6 Beiträge
Werte aus einer anderen xls-File kopieren
Horst

Hallo zusammen,
folgendes Problem stellt sich mir:
Ich will aus einer anderen Mappe mehrere Zeilen und Zellen kopieren. Je nachdem welche Mappe der Benutzer haben will, wird diese geöffnet und die gewünschten Daten kopiert.
Hier mein Ansatz:
Code:
Sub Kopieren()
Di...
08.10.2008 10:43:00
Thread-ID: 1014931
2 Beiträge
Minus-Zeit als Ergebnis einer Formel
Rico

Hallo liebe Ex(cel)perten
Ich kommen langsam aber stetig voran und ich entschuldige mich jetzt schon da ich weiss, dass diese Probleme viel besprochen werden in diesem genialen Forum aber ich hab leider auf mein Problem keine Lösung gefunden in der Recherche.
Gemäss Beispielmappe: https...
09.10.2008 11:31:11
Thread-ID: 1015298
3 Beiträge
Formel ganz ausblenden wenn Werte fehlen !?
nathan

Einen schönen Nachmittag,
kann ich ein Ergebnis in einer Formel solange ausblenden lassen, bis die benötigten Werte eingegeben wurden?
Beispiel:
E3 = 5
E4 = 7
E5 = (E3+E4)
Angezeigt wird: 12
E3 = 5
E4=
E5 = (E3+E4)
Nichts wird angezeigt.
oder
"We...
09.10.2008 15:18:01
Thread-ID: 1015360
2 Beiträge
in Ergebnis einer Formel Text mit ausgeben
Walter

Nochmals Hallo,
leider die Lösung vergessen, wie man in einer Berechnungsformel, nen fest fixierten Text ausgeben kann.
Beispielergebnis: 12 Bananen (12 ist errechnet, Bananen ist der feste Text.
War, glaube ich, ganz einfach :-(((
Danke + Gruß
Walter
23.10.2008 23:15:29
Thread-ID: 1018831
7 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
7
4
1
4
2
5
1
2
1
6
6
2
17
6
6
6
6
2
3
5
6
7
2
4
2