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

Erweiterung im Makro

Erweiterung im Makro
30.10.2012 13:57:39
Chris
Hallo,
ich nutze folgendes Makro um Daten in eine Datei einzulesen. Nun soll der erste Datensatz in Zeile 4 (C4 bis N4) und die folgenden immer eine Zeile darunter bis zur Zeile 112.
Wie kann ich das erweitern/verändern? Danke im Voraus!
Chris
Sub DatenEinlesen()
Dim wbZiel As Workbook, wbQuelle As Workbook, rngDaten As Range, i As Integer
Dim Bereich(1 To 3) As String
Dim Zeile(1 To 3) As Long 'Oberen Index festlegen entsprechend der Anzahl Bereiche die  _
Kopiert werden sollen
Set wbZiel = Workbooks.Open(Filename:="C:\Tipplisten Sp10-12.xls") 'Datei in die die Daten  _
kopiert werden sollen
Bereich(1) = "A4:L4" 'Bereich, der in 1. Tabelle kopiert werden soll
Bereich(2) = "A10:L10" 'Bereich, der in 2. Tabelle kopiert werden soll
Bereich(3) = "A16:L16" 'Bereich, der in 3. Tabelle kopiert werden soll
'Nächste frei Zielzeile in den Tabellen der Zieltabellen ermitteln
For i = 1 To UBound(Zeile)
With wbZiel.Sheets(i)
' Zeile(i) = .UsedRange.Row + .UsedRange.Rows.Count
'Alternative Möglichkeit
'Nachfolgend Spalte wählen in der immer Daten stehen!
Zeile(i) = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
End With
Next i
Do
'Datendatei öffnen
Datei = Application.Dialogs(xlDialogOpen).Show
If Datei = False Then Exit Sub
Application.ScreenUpdating = False
Set wbQuelle = ActiveWorkbook
'Formate und Daten aus den Bereichen in die Zieltabellen kopieren
For i = 1 To UBound(Bereich)
Set rngDaten = wbQuelle.Sheets(1).Range(Bereich(i))
rngDaten.Copy
With wbZiel.Sheets(i)
.Cells(Zeile(i), "A").PasteSpecial Paste:=xlFormats
.Cells(Zeile(i), "A").PasteSpecial Paste:=xlValues
End With
Zeile(i) = Zeile(i) + 1
Next i
Application.CutCopyMode = False
wbQuelle.Close Savechanges = False
Application.ScreenUpdating = True
wbZiel.Save
Loop Until MsgBox("Weitere Datei bearbeiten?", vbQuestion + vbYesNo, "Daten einlesen") = vbNo
wbZiel.Close
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Für das gezeigte Makro sind deine Ausführungen ...
30.10.2012 16:09:40
Luc:-?
…zu dürftig, Chris,
denn das kopiert 3 Bereiche eines Blattes einer Mappe in je ein Blatt einer anderen Mappe und zwar ohne Formeln. Davon ist bei dir nicht die Rede, folglich wirst du wohl ein anderes Makro benötigen. Da diese Aufgabe häufiger vorkommt, würde ich an deiner Stelle mal im Archiv suchen. Da wirst du bestimmt fündig.
Gruß Luc :-?

AW: Für das gezeigte Makro sind deine Ausführungen ...
30.10.2012 19:28:18
Chris
Hallo,
ja, aus verschiedenen Dateien werden jeweils drei Bereiche kopiert und in der o.g. Datei eingefügt. Und dort soll es nach dem beschriebenen Kriterium erfolgen.
Aktuell erscheint der importierte Datensatz leider erst am Ende der Tabelle.

Anzeige
Deine Ausführungen scheinen mir aber ...
30.10.2012 19:57:16
Luc:-?
…nicht zu „Bereich(1) = "A4:L4" 'Bereich, der in 1. Tabelle kopiert werden soll“ usf zu passen!
Luc :-?

AW: Erweiterung im Makro
30.10.2012 21:04:53
Gerd
Hallo Chris,
alle 3 Bereiche ab C4 abwärts einfügen:
Sub DatenEinlesen()
Dim wbZiel As Workbook, wbQuelle As Workbook, rngDaten As Range, i As Integer
Dim Bereich(1 To 3) As String
Dim Zeile(1 To 3) As Long 'Oberen Index festlegen entsprechend der Anzahl Bereiche die _
Kopiert werden sollen
Set wbZiel = Workbooks.Open(Filename:="C:\Tipplisten Sp10-12.xls") 'Datei in die die Daten  _
_
kopiert werden sollen
Bereich(1) = "A4:L4" 'Bereich, der in 1. Tabelle kopiert werden soll
Bereich(2) = "A10:L10" 'Bereich, der in 2. Tabelle kopiert werden soll
Bereich(3) = "A16:L16" 'Bereich, der in 3. Tabelle kopiert werden soll
'Nächste frei Zielzeile in den Tabellen der Zieltabellen ermitteln
For i = 1 To UBound(Zeile)
With wbZiel.Sheets(i)
' Zeile(i) = .UsedRange.Row + .UsedRange.Rows.Count
'Alternative Möglichkeit
'Nachfolgend Spalte wählen in der immer Daten stehen!
Zeile(i) = Application.Max(4, .Cells(.Rows.Count, 3).End(xlUp).Row + 1)
End With
Next i
Do
'Datendatei öffnen
Datei = Application.Dialogs(xlDialogOpen).Show
If Datei = False Then Exit Sub
Application.ScreenUpdating = False
Set wbQuelle = ActiveWorkbook
'Formate und Daten aus den Bereichen in die Zieltabellen kopieren
For i = 1 To UBound(Bereich)
Set rngDaten = wbQuelle.Sheets(1).Range(Bereich(i))
rngDaten.Copy
With wbZiel.Sheets(i)
.Cells(Zeile(i), 3).PasteSpecial Paste:=xlFormats
.Cells(Zeile(i), 3).PasteSpecial Paste:=xlValues
End With
Zeile(i) = Zeile(i) + 1
Next i
Application.CutCopyMode = False
wbQuelle.Close Savechanges = False
Application.ScreenUpdating = True
wbZiel.Save
Loop Until MsgBox("Weitere Datei bearbeiten?", vbQuestion + vbYesNo, "Daten einlesen") =  _
vbNo
wbZiel.Close
End Sub
Gruß Gerd
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige