Fortschrittblaken für das copy & past von daten

Private Sub ComboBox1_Change() Dim wks, wks1 As Worksheet Set ext_wb = Workbooks.Open(ThisWorkbook.Path & "\20180110_Datenbasis.xlsx", UpdateLinks:=1) For Each wks In Workbooks("20180110_Datenbasis.xlsx").Worksheets ThisWorkbook.Activate If Worksheets("Tabelle1").ComboBox1.Value = wks.Name Then Workbooks("20180110_Datenbasis.xlsx").Worksheets(wks.Name).Range("A1:X65").Copy _ Workbooks("BigDataChild.xlsm").Worksheets("Import").Range("A1").PasteSpecial Paste:=xlPasteValues End If Next Application.CutCopyMode = False Workbooks("20180110_Datenbasis.xlsx").Close savechanges:=False Workbooks("BigDataChild.xlsm").Activate End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo ?,
in ein allgemeines Modul:

Option Explicit

Enum BARMODE
  BM_BAR
  BM_SQUARE
End Enum

Sub Status_Progress(SP_Progress As Long, SP_Max As Long, Optional SP_Text As String = "Status:", _
  Optional SP_Length As Long = 50, Optional SP_BarMode As BARMODE = BM_BAR)
Dim dblAct As Double, lngProg As Long, strBar As String, strFill As String
Static lngC As Long
Static bolDir As Boolean

On Error GoTo ErrExit

SP_Length = Application.Min(100, Application.Max(5, SP_Length))

If SP_BarMode = BM_BAR Then
  strBar = ChrW(9607)
  strFill = ChrW(9602)
Else
  strBar = ChrW(11035)
  strFill = ChrW(11036)
End If

If SP_Max > 0 Then
  dblAct = SP_Progress / SP_Max
  lngProg = dblAct * SP_Length
  
  If dblAct < 1 Then
    Application.StatusBar = SP_Text & " " & String(lngProg, strBar) & _
      String(SP_Length - lngProg, strFill) & Format(dblAct, " 0 %")
    DoEvents
  Else
    Application.StatusBar = False
  End If
ElseIf SP_Max = 0 Then
  If Not bolDir Then
    lngC = lngC + 1
  Else
    lngC = lngC - 1
  End If
  If lngC = 0 Then bolDir = False
  If lngC >= SP_Length Then bolDir = True
  Application.StatusBar = SP_Text & " " & String(lngC, strFill) & String(3, strBar) & _
    String(SP_Length - lngC, strFill)
  DoEvents
Else
  lngC = -1
  bolDir = False
  Application.StatusBar = False
End If
Exit Sub
ErrExit:
lngC = -1
bolDir = False
Application.StatusBar = False
End Sub

Dein Code:

Private Sub ComboBox1_Change()
Dim wks As Worksheet, ext_wb As Workbook, lngI As Long

Set ext_wb = Workbooks.Open(ThisWorkbook.Path & "\20180110_Datenbasis.xlsx", UpdateLinks:=1)
With ext_wb
  For Each wks In .Worksheets
    lngI = lngI + 1
    Call Status_Progress(lngI, .Worksheets.Count)
    If Worksheets("Tabelle1").ComboBox1.Value = wks.Name Then
      wks.Range("A1:X65").Copy
      Workbooks("BigDataChild.xlsm").Worksheets("Import").Range("A1").PasteSpecial Paste:=xlPasteValues
    End If
  Next
  Application.CutCopyMode = False
  .Close savechanges:=False
End With
Workbooks("BigDataChild.xlsm").Activate

Set wks = Nothing
Set ext_wb = Nothing
End Sub

PS.: Wenn du Variablen verwendest, dann solltest du sie auch deklarieren und vor allem auch entsprechend nutzen!

Gruß Sepp

Private Sub ComboBox1_Change() Dim wks As Worksheet, ext_wb As Workbook, lngI As Long Set ext_wb = Workbooks.Open(ThisWorkbook.Path & "\20180110_Datenbasis.xlsx", UpdateLinks:=1) With ext_wb For Each wks In .Worksheets lngI = lngI + 1 Call Status_Progress(lngI, .Worksheets.Count) If Me.ComboBox1.Value = wks.Name Then wks.Range("A1:X65").Copy Workbooks("BigDataChild.xlsm").Worksheets("Import").Range("A1").PasteSpecial Paste:=xlPasteValues End If Next Application.CutCopyMode = False .Close savechanges:=False End With Workbooks("BigDataChild.xlsm").Activate Set wks = Nothing Set ext_wb = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Fortschrittblaken für das copy & past von daten

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Fortschrittblaken für das copy & past von daten

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

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread