Thema Datum  Von Nutzer Rating
Antwort
Rot Makro soll nur definierten Zellenbreich kopieren
14.04.2014 14:49:49 Benjamin Gerold
NotSolved
15.04.2014 15:38:58 Andy G
NotSolved

Ansicht des Beitrags:
Von:
Benjamin Gerold
Datum:
14.04.2014 14:49:49
Views:
1235
Rating: Antwort:
  Ja
Thema:
Makro soll nur definierten Zellenbreich kopieren
Hallo zusammen, ich habe mir mal ein makro schreiben lassen, um verschiedene Projektterminpläne (aale mit dem gleichen Aufbau) in einer Datei zusammenzuführen. Das klappt auch soweit. Nun ist es jedoch so, dass ich nur einen bestimmten Bereich über das makro abfragen und in die Zusammenführungsdatei schreiben lassen möchte. Das das kopieren in Zelle 7 startet ist ok. Nur soll nur bis einschließlich Zeile 18 kopiert werden und dann in die nächste Datei gesprungen werden. Könnt ihr mir helfen? Vielen Dank schon mal vorab, Ben Hier der VBA Code den ich nutze: Option Explicit Const HomeDatei = "Controlling Produktprojekte.xls" 'Name Arbeitsmappe Makro-Excel-Datei Const HomeDaten = "Daten-Import" 'Name Tabellenblatt Daten-Import Const HomeListe = "Datei-Liste" 'Name Tabellenblatt Datei-Liste Const HomeZeile = 7 'Erste Zeile Einfügen Const CopyZeile = 7 'Erste Zeile Kopieren Const ListDatei = "A1" 'Zelle erster Dateiname Const ErrMsg = "Abbruch! Datei existiert nicht: " Sub SheetsImport() Dim WksHome As Worksheet, WksList As Worksheet, EndLine As Integer, NextLine As Integer Dim WkbCopy As Workbook, WksCopy As Worksheet, Fso As Object, File As Object Set Fso = CreateObject("Scripting.FileSystemObject") Set WksHome = Workbooks(HomeDatei).Sheets(HomeDaten) Set WksList = Workbooks(HomeDatei).Sheets(HomeListe) EndLine = GetEndLine(WksHome): NextLine = HomeZeile If EndLine >= HomeZeile Then WksHome.Rows("7:" & EndLine).Cells.Clear Application.ScreenUpdating = False For Each File In WksList.Range(ListDatei).CurrentRegion If Fso.FileExists(File) = False Then Application.ScreenUpdating = True MsgBox ErrMsg & File, vbExclamation, "Fehler": Exit Sub End If Set WkbCopy = Workbooks.Open(File): Set WksCopy = WkbCopy.Sheets(1) EndLine = GetEndLine(WksCopy) If EndLine >= CopyZeile Then WksCopy.Rows("7:" & EndLine).Copy WksHome.Rows(NextLine).Insert Shift:=xlDown Application.CutCopyMode = False WkbCopy.Saved = True: WkbCopy.Close NextLine = GetEndLine(WksHome) + 1 End If Next Application.ScreenUpdating = True End Sub Private Function GetEndLine(ByRef Wks) As Integer GetEndLine = Wks.Cells(Wks.Rows.Count, "A").End(xlUp).Row End Function

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Makro soll nur definierten Zellenbreich kopieren
14.04.2014 14:49:49 Benjamin Gerold
NotSolved
15.04.2014 15:38:58 Andy G
NotSolved