Excel: Bereiche kopieren

Dieses Thema Excel: Bereiche kopieren im Forum "Microsoft Office Suite" wurde erstellt von Arne2007, 16. Apr. 2008.

Thema: Excel: Bereiche kopieren Hallo, ich möchte aus einer externen Datei (die Bereiche sind unten einsehbar) in eine neue Datei zwei Bereiche...

  1. Hallo,

    ich möchte aus einer externen Datei (die Bereiche sind unten einsehbar) in eine neue Datei zwei Bereiche kopieren.
    Der Code da unten funktioniert nicht, d.h. es wird immer nur der zweite Bereich kopiert.
    Wie kann ich den Pfad der externen Tabelle angeben?

    Vielen Dank im Voraus :) und viele Grüße,

    Arne

    Code:
    Sub Kopieren()
    Set cpy = Worksheets(eins).Range(A3:CV4)
    cpy.Copy Destination:=Worksheets(pivot).Range(A1)
    End Sub
    
    Sub Kopieren_VT()
    Set cpy = Worksheets(eins).Range(A6:CV10)
    cpy.Copy Destination:=Worksheets(pivot).Range(A3)
    End Sub
    
     
  2. Habe den Code soweit hinbekommen :), jedoch fehlt mir noch der Zugriff auf ein externes Excelsheet.
    Hat dort jemand eine Idee wie man das realisieren kann?

    Code:
    Sub Kopieren()
    Set cpy1 = Worksheets(eins).Range(A3:CV4)
    cpy1.Copy Destination:=Worksheets(pivot).Range(A1)
    Set cpy = Worksheets(eins).Range(A6:CV10)
    cpy.Copy Destination:=Worksheets(pivot).Range(A3)
    End Sub
     
  3. Hallo Arne2007,

    mit folgendem Makro sollte es klappen. Die Konstanten mußt du deinen Gegebenheiten anpassen.

    Gruß Matjes :)
    Code:
    Sub BereichKopieren()
     Dim wb_quelle As Workbook, range_ziel As Range, range_quelle As Range
     Dim bSchonOffen As Boolean
     
    ->>>>>>>>>>>>>> A N P A S S E N >>>>>>>>>>>>>>>>
     Const cWBQUELLE_DATEINAME = Mappe1.xls->Name der Quelldatei
     Const cWBQUELLE_PFAD = F:\Test    ->Pfad der Quelldatei
     Const cWSQUELLE_NAME = eins     ->Name des Quellblattes
     Const cRANGEQUELLE = A3:CV4     ->Bereich auf dem Quellblatt
     
     Const cWSZIEL_NAME = xyz       ->Name des Zielblattes
    ->>>>>>>>>>>>>> A N P A S S E N  E N D E >>>>>>
     
     On Error Resume Next
     Set range_ziel = ActiveWorkbook.Worksheets(cWSZIEL_NAME).Range(A1)
     On Error GoTo 0
     Err.Clear
     If range_ziel Is Nothing Then
      MsgBox Zielbereich ist nicht erreichbar.
      GoTo AUFRAEUMEN
     End If
     
     For Each wb_quelle In Workbooks
      If wb_quelle.Name = cWBQUELLE_DATEINAME Then
       bSchonOffen = True
       Exit For
      End If
     Next
     If Not bSchonOffen Then
      On Error Resume Next
      Set wb_quelle = Workbooks.Open(Filename:= _
         cWBQUELLE_PFAD & Application.PathSeparator & cWBQUELLE_DATEINAME)
      On Error GoTo 0
      Err.Clear
     End If
     If wb_quelle Is Nothing Then
      MsgBox cWBQUELLE_PFAD & Application.PathSeparator & _
          cWBQUELLE_DATEINAME & konnte nicht geöffnet werden.
      GoTo AUFRAEUMEN
     End If
     
     On Error Resume Next
     Set range_quelle = wb_quelle.Worksheets(cWSQUELLE_NAME).Range(cRANGEQUELLE)
     On Error GoTo 0
     Err.Clear
     If range_quelle Is Nothing Then
      MsgBox Quellbereich ist nicht erreichbar.
      GoTo AUFRAEUMEN
     End If
     
     range_quelle.Copy Destination:=range_ziel
    
     If Not bSchonOffen Then wb_quelle.Close Savechanges:=False
    
    AUFRAEUMEN:
     Set wb_quelle = Nothing: Set range_ziel = Nothing: Set range_quelle = Nothing
    End Sub
     
  4. Servus Matjes,

    vielen Dank für deinen Code, der funktioniert hervorragend :).
    Leider möchte ich zwei Bereiche Bereiche kopieren und ich weiß nicht wie ich da noch ein cpy einbauen kann.

    Grüße aus dem Münsterland,

    Arne
     
  5. Hallo Arne,

    mit der folgenden Version sollte es dir auch möglich sein noch mehr Bereiche einzubauen.

    Gruß Matjes ;)
    Code:
    Sub MeherereBereicheKopieren()
    ->>>>>>>>>>>>>> A N P A S S E N >>>>>>>>>>>>>>>>
     Const c1WBQUELLE_DATEINAME = Mappe1.xls->Name der Quelldatei
     Const c1WBQUELLE_PFAD = F:\Test    ->Pfad der Quelldatei
     Const c1WSQUELLE_NAME = eins     ->Name des Quellblattes
     Const c1RANGEQUELLE = A3:CV4     ->Bereich auf dem Quellblatt
     Const c1WSZIEL_NAME = xyz       ->Name des Zielblattes
     Const c1RANGEZIEL = A1        ->Bereich auf dem Quellblatt
     
     Const c2WBQUELLE_DATEINAME = Mappe2.xls->Name der Quelldatei
     Const c2WBQUELLE_PFAD = F:\Test    ->Pfad der Quelldatei
     Const c2WSQUELLE_NAME = eins     ->Name des Quellblattes
     Const c2RANGEQUELLE = A3:CV4     ->Bereich auf dem Quellblatt
     Const c2WSZIEL_NAME = xyz       ->Name des Zielblattes
     Const c2RANGEZIEL = A3        ->Bereich auf dem Quellblatt
    ->>>>>>>>>>>>>> A N P A S S E N  E N D E >>>>>>
    
     Dim ws_ziel As Workbook
    
     Set ws_ziel = ActiveWorkbook
    
     Call EinenBereichKopieren(c1WBQUELLE_DATEINAME, _
                  c1WBQUELLE_PFAD, _
                  c1WSQUELLE_NAME, _
                  c1RANGEQUELLE, _
                  ws_ziel, _
                  c1WSZIEL_NAME, _
                  c1RANGEZIEL)
    
     Call EinenBereichKopieren(c2WBQUELLE_DATEINAME, _
                  c2WBQUELLE_PFAD, _
                  c2WSQUELLE_NAME, _
                  c2RANGEQUELLE, _
                  ws_ziel, _
                  c2WSZIEL_NAME, _
                  c2RANGEZIEL)
    
    AUFRAEUMEN:
     Set ws_ziel = Nothing
    End Sub
    
    Private Function EinenBereichKopieren(sWBQUELLE_DATEINAME As String, _
                       sWBQUELLE_PFAD As String, _
                       sWSQUELLE_NAME As String, _
                       sRANGEQUELLE As String, _
                       wb_ziel As Workbook, _
                       sWSZIEL_NAME As String, _
                       sRANGEZIEL As String)
     
     Dim wb_quelle As Workbook, range_ziel As Range, range_quelle As Range
     Dim bSchonOffen As Boolean
     Dim sFullName As String
     
     
     On Error Resume Next
     Set range_ziel = wb_ziel.Worksheets(sWSZIEL_NAME).Range(sRANGEZIEL)
     On Error GoTo 0
     Err.Clear
     If range_ziel Is Nothing Then
      MsgBox Zielbereich ist nicht erreichbar. & vbLf & Blatt:  & sWSZIEL_NAME
      GoTo AUFRAEUMEN
     End If
     
     For Each wb_quelle In Workbooks
      If wb_quelle.Name = sWBQUELLE_DATEINAME Then
       bSchonOffen = True
       Exit For
      End If
     Next
     If Not bSchonOffen Then
      On Error Resume Next
      sFullName = sWBQUELLE_PFAD & Application.PathSeparator & sWBQUELLE_DATEINAME
      Set wb_quelle = Workbooks.Open(Filename:=sFullName)
      On Error GoTo 0
      Err.Clear
     End If
     If wb_quelle Is Nothing Then
      MsgBox sFullName &  konnte nicht geöffnet werden.
      GoTo AUFRAEUMEN
     End If
     
     On Error Resume Next
     Set range_quelle = wb_quelle.Worksheets(sWSQUELLE_NAME).Range(sRANGEQUELLE)
     On Error GoTo 0
     Err.Clear
     If range_quelle Is Nothing Then
      MsgBox _
       Quellbereich ist nicht erreichbar. & vbLf & _
       Blatt:  & sWSQUELLE_NAME & vbLf & _
       Bereich:  & sRANGEQUELLE
      GoTo AUFRAEUMEN
     End If
     
     range_quelle.Copy Destination:=range_ziel
    
     If Not bSchonOffen Then wb_quelle.Close Savechanges:=False
    
    AUFRAEUMEN:
     Set wb_quelle = Nothing: Set range_ziel = Nothing: Set range_quelle = Nothing
    End Function
     
  6. Jawoll, vielen Dank :)
     
Die Seite wird geladen...

Excel: Bereiche kopieren - Ähnliche Themen

Forum Datum
Excel: Bereiche auf 'leer' Überprüfen Microsoft Office Suite 15. Sep. 2016
Excel 2010: Zufallsauswahl innerhalb eines Bereiches Microsoft Office Suite 24. Okt. 2011
EXCEL 2010 - Mehrere Zellbereiche in Formel Windows XP Forum 13. Sep. 2010
Excel, einzelne zeilen (Bereiche) schützen Windows XP Forum 20. Feb. 2006
Excel: Bereiche grau dargestellt / werden nicht gedruckt Microsoft Office Suite 18. März 2005