Thema Datum  Von Nutzer Rating
Antwort
19.09.2017 10:09:39 Fabian
NotSolved
19.09.2017 10:41:03 Gast70861
NotSolved
19.09.2017 11:34:34 Gast24071
NotSolved
Blau Datenimport aus mehreren Exceldateien
 19.09.2017 15:17:48 Gast70861
NotSolved
19.09.2017 15:24:48 Gast70861
NotSolved

Ansicht des Beitrags:
Von:
Gast70861		 Datum:
19.09.2017 15:17:48		 Views:
996		 Rating:
     
Antwort:
  Ja
Thema:
Datenimport aus mehreren Exceldateien

und und viele Grüsse

Option Explicit

Sub GetIt()
'oder umgekehrt - oder was
Const C_SrcTtl As Boolean = True 'Quelle hat Überschrift
Const C_TrgTtl As Boolean = False 'Ziel hat keine Überschrift
'
Dim oDlg As FileDialog, V
Dim oWbData As Excel.Workbook
Dim oWsData As Excel.Worksheet, oWsResult As Excel.Worksheet
Dim rngFrom As Range, rngTo As Range
Dim lngTo As Long, lngFrom As Long
Dim bln As Boolean: bln = Application.ScreenUpdating

Application.ScreenUpdating = False
On Error GoTo fail

   Set oWsResult = ThisWorkbook.Sheets(1)
   With oWsResult
      Set rngTo = .Cells(1, .Columns.Count).End(xlToLeft)
      If rngTo.Value <> "" Then Set rngTo = rngTo.Offset(, 1)
   End With
   lngFrom = IIf(C_SrcTtl, 2, 1)
   lngTo = IIf(C_TrgTtl, 1, 0)
   Set oDlg = Application.FileDialog(msoFileDialogOpen)
   With oDlg
      .AllowMultiSelect = True
      .Filters.Clear
      .Filters.Add "Excel-Datei(en)", "*.xls?"
      .Show
      For Each V In .SelectedItems
         Set oWbData = Workbooks.Open(V)
         With oWbData
            Set oWsData = Sheets(1)
               With oWsData.Columns("C")
                  Set rngFrom = Range(.Cells(lngFrom), .Cells(lngFrom).End(xlDown))
               End With
            rngFrom.Copy rngTo.Offset(lngTo)
            .Close False
         End With
         Set rngTo = rngTo.Offset(, 1)
        Next
   End With

On Error GoTo 0
fail:
Application.ScreenUpdating = bln
End Sub

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
19.09.2017 10:09:39 Fabian
NotSolved
19.09.2017 10:41:03 Gast70861
NotSolved
19.09.2017 11:34:34 Gast24071
NotSolved
Blau Datenimport aus mehreren Exceldateien
 19.09.2017 15:17:48 Gast70861
NotSolved
19.09.2017 15:24:48 Gast70861
NotSolved