Microsoft Excel

Herbers Excel/VBA-Archiv

Inhalte in eine externe Datei untereinander kopier | Herbers Excel-Forum


Betrifft: Inhalte in eine externe Datei untereinander kopier von: Mona
Geschrieben am: 18.01.2012 10:15:56

Hallo
Ich benötige eure Hilfe. Ich möchte ein Makro schreiben, dass einzelne Worksheets aus einer anderen Datei untereinander zusammenkopiert. Anfangen soll er in der Zelle AJ16.

Der NAme der Datei soll sich in der Zelle B2 meines Variablenblatts befinden und in dieser Datei soll er auch als weiteres Arbeitsblatt die Zusammenfassung reinkopieren.
Für ein Blatt funktioniert es, allerdings stehe ich gerade vor dem Problem zu sagen, dass er das nächste Sheet unter den bereits kopierten Werten in der Zusammenfassung ablegen soll.
Ist es auch möglich in dem Variablensheet die Namen der Arbeitsblätter zu nennen und das Makro dann darauf hin zu verweisen. Somit könnte es einfach erweitert werden.
Momentan wähle ich nur irgendwelche Arbeitsblätter an.

Über jegliche Hilfe wäre ich sehr dankbar.

Sub untereinanderkopieren()
 Dim i As Integer
 Dim r As Range
 Dim letzteZeile As Long
 Dim lngLastRow As Long


 Dim letzteZelle As Range
   Range("B2").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    With ActiveWorkbook
 For i = 2 To .Worksheets.Count

 For Each r In ActiveSheet.UsedRange
 If r.Rows.Hidden = False Then
 letzteZeile = r.Row
 End If
 Next
 Range("AJ16:AW" & letzteZeile).Copy
 Windows("Menu").Activate
 Sheets("rohdaten").Select
 lngLastRow = Sheets(ActiveWorkbook.Sheets.Count).Cells(1, 1).End(xlUp).Row + 1
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Next
End With
End Sub

  

Betrifft: AW: Inhalte in eine externe Datei untereinander kopier von: fcs
Geschrieben am: 18.01.2012 15:31:02

Hallo Mona,

damit du die beim Kopiervorgang die beteiligten Arbeitsmappen und Tabellenblätter besser verfolgen kannst solltest du mit Objektvariablen arbeiten. Dann kannst du alle Zellbereiche direkt ansprechen und bist nicht auf Activate, Select, Selection angewiesen.

Mehrere Zellen mit Hyperlinks kannst du in einer weiteren For-Next-Schleife abarbeiten.

Gruß
Franz

Sub untereinanderkopieren()
  Dim i As Integer
  Dim r As Range
  Dim letzteZeile As Long
  Dim lngLastRow As Long
  Dim lngZeile As Long
  
  Dim wbAktiv As Workbook, wksVariablen As Worksheet, wksZiel As Worksheet
  Dim wbQuelle As Workbook, wksQuelle As Worksheet
  
  Set wbAktiv = ActiveWorkbook 'Datei Menu  ???
  Set wksVariablen = wbAktiv.Worksheets("Variablen") 'Name anpassen!!!
  Set wksZiel = wbAktiv.Worksheets("rohdaten") 'Muster-Blatt in das die Daten kopiert werden
  
  With wksVariablen
    Application.ScreenUpdating = False
    'Hyperlinks in Spalte B ab Zeile 2 abarbeiten
    For lngZeile = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
      With .Cells(lngZeile, 2)
        'Prüfen, ob Zelle einen Hyperlink hat
        If .Hyperlinks.Count > 0 Then
          .Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        Else
          GoTo NextZelle
        End If
      End With
      Set wbQuelle = ActiveWorkbook
      
      'Zielblatt aufbereiten - Altdaten löschen
      With wksZiel
        lngLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
        If lngLastRow > 1 Then
          .Range(.Rows(2), .Rows(lngLastRow)).ClearContents
        End If
      End With
      
      With wbQuelle
        For i = 2 To .Worksheets.Count
          Set wksQuelle = wbQuelle.Worksheets(i)
          For Each r In wksQuelle.UsedRange
            If r.Rows.Hidden = False Then
              letzteZeile = r.Row
            End If
          Next r
          
          wksQuelle.Range("AJ16:AW" & letzteZeile).Copy
          
          With wksZiel
            'nächste freie Zeile in Spalte A
            lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(lngLastRow, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                 SkipBlanks:=False, Transpose:=False
          End With
        Next i
        'Tabellenblatt mit rohdaten nach Quelldatei  vor das 1. Blatt kopieren
        wksZiel.Copy before:=.Sheets(1)
        .Sheets(1).Name = "Zusammenfassung"
        .Save
        '.close  'ggf. aktivieren, wenn die Quelle wieder geschlossen werden soll
      End With
NextZelle:
    Next lngZeile
    Application.ScreenUpdating = True
  End With
End Sub



Beiträge aus den Excel-Beispielen zum Thema "Inhalte in eine externe Datei untereinander kopier"