Kopieren von verschiedenen Zellbereichen aus mehreren Tabellenblättern in 1 neues Tabellenblatt mit Zahlenwertformat

  • Excel

Es gibt 12 Antworten in diesem Thema. Der letzte Beitrag () ist von petaod.

    Kopieren von verschiedenen Zellbereichen aus mehreren Tabellenblättern in 1 neues Tabellenblatt mit Zahlenwertformat

    Hallo Forumgemeinde,

    ich habe eine komplexe Aufgabe bekommen und stoße nun an meine Grenzen. Vllt. kann mir an der Stelle jemand von Euch behilflich sein. Dafür schon mal Besten Dank.

    Ich habe eine Datei die aus einer Vielzahl von Tabellenblättern besteht. Die einzelnen Tabellenblätter haben immer die gleiche Struktur, nur der Zellwert verändert sich. Ich suche jetzt nach einer Möglichkeit die immer gleichen Zelllbreiche (da ja jedes Tabellenblatt die gleiche Struktur hat) in ein einziges neues Tabellenblatt zu übertragen, so dass die Daten aus den Tabellenblättern als fortlaufende Liste gespeichert werden.

    Ich hab das mal mit diesem Code hier probiert, der auch soweit funktioniert. Nur bin ich jedesmal wenn sich die Anzahl der Tabellenblätter ändert, dazu gezwungen das Makro wieder anzupassen. Durch dieses Forum hier habe ich gelernt, dass es Möglichkeiten gibt sämtliche Tabellenblätter z.B. mit einem Format zu Versehen, so viele wie halt vorhanden sind. Vllt. gibt es ja auch einen Code, der das Kopieren über sämtliche Tabellenblätter übernimmt. Ich denke, dass es hier schlaue Köpfe gibt, die das sicher sinnvoller programmieren würden:


    Sub Kopieren()
    '
    ' Kopieren Makro
    '
    ' Tastenkombination: Strg+Umschalt+K
    '
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Reich A. AIDe").Select
    Range("C2").Select
    Selection.Copy
    Sheets("Tabelle1").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("B1").Select
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Reich A. AIDe").Select
    Range("C9:H39").Select
    ActiveWindow.SmallScroll Down:=-3
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Batu AIDe").Select
    Range("C2").Select
    Selection.Copy
    Sheets("Tabelle1").Select
    Range("A32").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("B32").Select
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Batu AIDe").Select
    Range("C9:H39").Select
    ActiveWindow.SmallScroll Down:=-3
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Bergius AIDe").Select
    Range("C2").Select
    Selection.Copy
    Sheets("Tabelle1").Select
    Range("A63").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("B63").Select
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Bergius AIDe").Select
    Range("C9:H39").Select
    ActiveWindow.SmallScroll Down:=-3
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Wolf AIDe").Select
    Range("C2").Select
    Selection.Copy
    Sheets("Tabelle1").Select
    Range("A94").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("B94").Select
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Wolf AIDe").Select
    Range("C9:H39").Select
    ActiveWindow.SmallScroll Down:=-3
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
    End Sub

    Ich habe mir auf der Suche nach einer sinnvollen Variante schon die Finger wund gegoogelt, aber keinen brauchbaren Input gefunden, der mir an dieser Stelle weiter hilft. Vllt. war ich auch zu dauserig dazu.

    Ich freue mich auf Eure Ideen.
    "mit VB Tag"

    Visual Basic-Quellcode

    1. Sub Kopieren()
    2. '
    3. ' Kopieren Makro
    4. '
    5. ' Tastenkombination: Strg+Umschalt+K
    6. '
    7. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    8. Sheets("Reich A. AIDe").Select
    9. Range("C2").Select
    10. Selection.Copy
    11. Sheets("Tabelle1").Select
    12. Range("A1").Select
    13. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    14. :=False, Transpose:=False
    15. Range("B1").Select
    16. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    17. Sheets("Reich A. AIDe").Select
    18. Range("C9:H39").Select
    19. ActiveWindow.SmallScroll Down:=-3
    20. Application.CutCopyMode = False
    21. Selection.Copy
    22. Sheets("Tabelle1").Select
    23. Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    24. xlNone, SkipBlanks:=False, Transpose:=False
    25. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    26. Sheets("Batu AIDe").Select
    27. Range("C2").Select
    28. Selection.Copy
    29. Sheets("Tabelle1").Select
    30. Range("A32").Select
    31. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    32. :=False, Transpose:=False
    33. Range("B32").Select
    34. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    35. Sheets("Batu AIDe").Select
    36. Range("C9:H39").Select
    37. ActiveWindow.SmallScroll Down:=-3
    38. Application.CutCopyMode = False
    39. Selection.Copy
    40. Sheets("Tabelle1").Select
    41. Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    42. xlNone, SkipBlanks:=False, Transpose:=False
    43. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    44. Sheets("Bergius AIDe").Select
    45. Range("C2").Select
    46. Selection.Copy
    47. Sheets("Tabelle1").Select
    48. Range("A63").Select
    49. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    50. :=False, Transpose:=False
    51. Range("B63").Select
    52. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    53. Sheets("Bergius AIDe").Select
    54. Range("C9:H39").Select
    55. ActiveWindow.SmallScroll Down:=-3
    56. Application.CutCopyMode = False
    57. Selection.Copy
    58. Sheets("Tabelle1").Select
    59. Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    60. xlNone, SkipBlanks:=False, Transpose:=False
    61. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    62. Sheets("Wolf AIDe").Select
    63. Range("C2").Select
    64. Selection.Copy
    65. Sheets("Tabelle1").Select
    66. Range("A94").Select
    67. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    68. :=False, Transpose:=False
    69. Range("B94").Select
    70. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    71. Sheets("Wolf AIDe").Select
    72. Range("C9:H39").Select
    73. ActiveWindow.SmallScroll Down:=-3
    74. Application.CutCopyMode = False
    75. Selection.Copy
    76. Sheets("Tabelle1").Select
    77. Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    78. xlNone, SkipBlanks:=False, Transpose:=False
    79. End Sub


    Herzlich Willkommen im Forum

    VB TAG benutzen!
    Ich schaue mir deinen Code lieber nicht an.
    So sieht ein Negativbeispiel aus, das lediglich mit dem Macrorecorder zusammengeklickt wurde.

    Aber ich hätte einen Ansatz:

    Visual Basic-Quellcode

    1. Set SummarySheet = ThisWorkbook.Sheets("Summary")
    2. SummerySheet.Rows.Delete xlUp 'clear summary sheet
    3. For Each ws in ThisWorkbook.Sheets
    4. If ws.Name <> "Summary" Then
    5. Set DestCell=Summary.Cells(Rows.Count,1).End(xlUp).Offset(1)
    6. DestCell.Value = ws.Name
    7. DestCell.Offset(0,1).Value = ws.Range("A1").Value
    8. DestCell.Offset(0,2).Value = ws.Range("B55").Value
    9. DestCell.Offset(0,3).Value = ws.Range("X999").Value
    10. ws.Range("B6:F6").Copy DestCell.Offset(0,4)
    11. ws.Range("C7:D7").Copy DestCell.Offset(0,9)
    12. ' usw.
    13. End If
    14. Next
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „petaod“ ()

    Du hast recht, dass es mit dem Recorder aufgezeichnet wurde......Hm, na dann hab ich mich wohl damit gleich als VBA-Dauser geoutet. ;)
    Aber ich arbeite daran, dass es besser wird.

    Beim entschlüsseln des Codes hab ich noch so meine Probleme. Bis zu dem Ansatz "DestCell" hab ich mich vorgearbeitet und verstehe das auch. Ab DestCell weiß ich dann nicht mehr , was das Makro da genau macht. Auch kommt beim Debuggen dort ein Laufzeitfehler 424 - Objekt erforderlich. Ich vermute mal, dass ich an dieser Stelle noch was an meine Umgebung anpassen muss. Dazu müsste ich aber kapieren, was der Parameter DestCell bewirken soll.

    Kannst Du mir da weiterhelfen?

    petaod schrieb:

    Set DestCell=Summary.Cells(Rows.Count,1).End(xlUp).Offset(1)
    Hat eine Cut&Paste-Bremse drin. ;)
    Es müsste SummarySheet anstatt Summary heißen.

    Habe ich zwar nicht absichtlich reingemacht, aber das hättest du selbst rausfinden können.
    Der Ausdruck sucht einfach die erste belegte Zelle der ersten Spalte von unten weist die darunterliegende Zelle (also die erste freie Zelle) der Variablen DestCell zu.

    Ausgehend von dieser Zelle kannst du die danebenliegenden Zellen befüllen.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Ah....Merci für die Erklärung....hat mir sehr geholfen....Ich lerne, wenn auch nur recht langsam...Ich habe mir jetzt den Code soweit angepasst und scheitere jetzt an der Stelle, dass ich aus den einzelnen Sheets nur die Werte mit dem Zahlenformat kopieren möchte. Derzeit wird der Zellinhalt übergeben. In diesen Zellen sind Formeln hinterlegt, die aber im Summenblatt zu falschen Werten führen. Ich habe es schon mit diversen Formatierungsbefehlen versucht (paste, value), aber wahrscheinlich an falscher Stelle. Vllt. hast Du ja noch einen Tip an der Stelle für mich.
    So schaut mein Code jetzt aus:


    Visual Basic-Quellcode

    1. Sub Kopieren()
    2. Set Summarysheet = ThisWorkbook.Sheets("Summary")
    3. Summarysheet.Rows.Delete xlUp 'clear summary sheet
    4. For Each ws In ThisWorkbook.Sheets
    5. If ws.Name <> "Summary" Then
    6. Set DestCell = Summarysheet.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    7. DestCell.Offset(0, 0).Value = ws.Range("c2").Value
    8. ws.Range("c9:h39").Copy DestCell.Offset(0, 1)
    9. End If
    10. Next
    11. End Sub

    FraMeLix schrieb:

    DestCell.Offset(0, 0)
    Ist eine interessante Variante. :D
    In dem Fall darfst du auch gerne nur DestCell schreiben.

    nur die Werte mit dem Zahlenformat kopieren möchte
    Es gibt unterschiedliche Arten des Kopierens.
    Deswegen habe ich oben extra mehrere Varianten im Beispiel verarbeitet.
    Range("A2").Value = Range("A1").Value kopiert nur den Wert
    Range("A2").Formula = Range("A1").Formula kopiert die Formel, gibt's auch in der Variante FormalR1C1 für relative Adressierung.
    Range("A1").Copy Range("A2") kopiert alles (Werte, Formeln, Formate), so wie es Copy&Paste machen würde.

    Schau dir einfach mal das Objektmodell an und such dir raus, was du benötigst.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Hallo zusammen,

    ich hab ein ähnlich gelagertes Problem.
    Ich habe mehrere Einzeldateien, die alle exakt gleich aufgebaut sind. Aus diesen Dateien möchte ich jeweils in Zeile A ein Datum suchen und dann die komplette Zeile in eine andere Datei kopieren lassen. Das Datum kommt dabei immer nur einmal vor. Die Datei, in die die Werte kopiert werden sollen liegt in einem übergeordneten Ordner. Die Werte sollen immer in in die 1. leere Zeile des Tabellenblatts kopiert werden.

    Leider waren meine VBA-Kenntnisse nie sehr ausgeprägt und sind in den letzten Jahen noch stark eingerostst. Bisher habe ich mir folgenden Code zusammengesucht und gebastelt. Leider erhalte ich immer den Laufzeitfehler 91:Objektvariable oder With-Blockvariable nicht festgelegt

    Visual Basic-Quellcode

    1. Option Explicit
    2. Option Compare Text
    3. Const SuchPfad = "C:\Users\andyamo\Desktop\Makro" 'Such-Ordnerpfad
    4. Const SuchName = "*.xls*" 'Such-Dateien
    5. Const SuchSpalte = "A" 'Such-Spalte
    6. Const Msg = "Der angegebene Ordner existiert nicht!"
    7. Sub GetExternData()
    8. Dim Wkb As Workbook, Wks As Worksheet, WksHome As Worksheet
    9. Dim wbZiel As Workbook, wksZiel As Worksheet
    10. Dim strZiel As String, strPfadZiel As String
    11. Dim bolOpen As Boolean
    12. Dim Zeile_Z As Long, Zelle_Letzte As Range
    13. Dim Fso As Object, File As Object, Found As Range, Search As String, NextLine As Long
    14. Set Fso = CreateObject("Scripting.FileSystemObject")
    15. If Fso.FolderExists(SuchPfad) = False Then MsgBox Msg, vbExclamation, "Fehler": Exit Sub
    16. Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen...")
    17. If Search = "" Then Exit Sub
    18. Application.ScreenUpdating = False
    19. Set wksZiel = wbZiel.Worksheets("Zahlenbasis_BTG")
    20. With wksZiel
    21. 'nächste Einfüge-Zeile ermitteln
    22. Set Zelle_Letzte = .Cells.Find(What:="*", After:=Range("A1"), _
    23. LookIn:=xlFormulas, LookAt:=xlWhole, searchorder:=xlByRows, _
    24. searchdirection:=xlPrevious)
    25. If Zelle_Letzte Is Nothing Then
    26. Zeile_Z = 1
    27. Else
    28. Zeile_Z = Zelle_Letzte.Row + 1
    29. End If
    30. WksHome.Cells.ClearContents
    31. End With
    32. For Each File In Fso.GetFolder(SuchPfad).Files
    33. If File.Name Like SuchName And Not File.Name Like ThisWorkbook.Name Then
    34. Set Wkb = Workbooks.Open(File.Path)
    35. For Each Wks In Wkb.Worksheets
    36. If Not Wks.Columns(SuchSpalte).Find(Search, LookIn:=xlValues, LookAt:=xlPart) Is Nothing Then
    37. With WksHome.Rows(NextLine)
    38. NextLine = NextLine + 1
    39. End With
    40. End If
    41. Next
    42. Wkb.Close False
    43. End If
    44. Next
    45. WksHome.Columns("A:L").AutoFit
    46. Application.ScreenUpdating = True
    47. End Sub


    Weiß jemand Rat?
    Vielen Dank im Voraus!!!
    Hallo zusammen,

    auch ich habe ein kleines Problem.
    Ich versuche mit Visual Studio aus verschiedene Tabellenblättern, welche 1,2,3.... heissen (vereinfacht) und aus jedem Tabellenblatt soll Zelle Q6 in eine Zusammenfassung geschrieben werden.
    Ich habe jetzt schon verschiedene Sachen probiert, aber entweder passiert gar nichts, oder es werden die Formeln kopiert oder es kommen Fehlermeldungen.
    Ich habe mich mit VBA eigentlich recht wohl gefühlt, aber das Programm musste jetzt mit VB.net neu aufgesetzt werden....
    Kann mir jemand eine Hilfestellung geben?
    Im Moment schauts so aus:

    VB.NET-Quellcode

    1. With xlWorkBook.Sheets("PV_Out")
    2. .Cells.ClearContents()
    3. For Each ws In xlWorkBook.Worksheets
    4. If ws.Name <> "PV_Out" Then
    5. xlWorkBook.Sheets("Out_PV").range("A1").copy(xlWorkBook.Sheets("Out_PV").Range("Q6"))
    6. End If
    7. Next ws
    8. End With



    Danke :)

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „FranziB“ ()

    1) Willkommen im Forum
    2) Du hättest ruhig einen neuen Thread erzeugen können anstatt eine zwei Jahre Leiche auszugraben, zumal dein Anliegen mit dem vorherigen so gut wie nichts zu tun hat
    3) Streng genommen ist der Thread im VBA-Forum sogar falsch, aber da es sich um Excel handelt, ist das soweit akzeptabel

    FranziB schrieb:

    entweder passiert gar nichts, oder es werden die Formeln kopiert oder es kommen Fehlermeldungen
    Wenn du zu einem Code eine eindeutige Fehlerbeschreibung lieferst ist das wesentlich hilfreicher.
    So kann man nur vermuten.
    Ich nehme mal an:
    xlWorkBook.Sheets("Out_PV").range("A1").copy(xlWorkBook.Sheets("Out_PV").Range("Q6"))
    liesse sich durch
    xlWorkBook.Sheets("Out_PV").Range("Q6").Value = xlWorkBook.Sheets("Out_PV").Range("A1").Value(
    so abbilden, dass es tut, was du meinst.

    Falls nicht, bitte bessere Fehlerbeschreibung.

    Anmerkung: Der With-Block sorgt mehr für Verwirrung als für Erleichterung
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --