Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Erweiterung im Makro

Betrifft: Erweiterung im Makro von: Chris
Geschrieben am: 30.10.2012 13:57:39

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

  

Betrifft: Für das gezeigte Makro sind deine Ausführungen ... von: Luc:-?
Geschrieben am: 30.10.2012 16:09:40

…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 :-?


  

Betrifft: AW: Für das gezeigte Makro sind deine Ausführungen ... von: Chris
Geschrieben am: 30.10.2012 19:28:18

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.


  

Betrifft: Deine Ausführungen scheinen mir aber ... von: Luc:-?
Geschrieben am: 30.10.2012 19:57:16

…nicht zu „Bereich(1) = "A4:L4" 'Bereich, der in 1. Tabelle kopiert werden soll“ usf zu passen!
Luc :-?


  

Betrifft: AW: Erweiterung im Makro von: Gerd L
Geschrieben am: 30.10.2012 21:04:53

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