Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1244to1248
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
Inhaltsverzeichnis

Inhalte in eine externe Datei untereinander kopier

Inhalte in eine externe Datei untereinander kopier
Mona
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Inhalte in eine externe Datei untereinander kopier
18.01.2012 15:31:02
fcs
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

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige