Erweiterung im Makro
30.10.2012 13:57:39
Chris
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