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

Sheets befüllen ohne Öffnen

Sheets befüllen ohne Öffnen
03.01.2018 08:24:41
Burak
Guten Morgen,
gestern war ich etwas übermütig und dachte ich habe das Problem bewältigt bekommen, aber scheinbar doch nicht.
Also ich habe ein Makro dass auf Seite 1 nur ein Startbutton hat
Seite 2-6 sollen im Makro erst geleert, dann befüllt und dann formatiert werden.
Umgesetzt hatte ich das indem er immer für jeden Schritt jedes der 5 Sheets öffnet und den Vorgang durchführt.
Um es performanter zu machen, versuche ich die Vorgänge durchzuführen ohne die Sheets zu aktivieren/öffnen.
Beim Clearen hat es geklappt mit
    For i = 2 To Worksheets.Count
With Worksheets(i)
.Cells.Clear
If .ChartObjects.Count > 0 Then
.ChartObjects.Delete
End If
End With
Next
Jetzt habe ich es mit dem Import umschreiben versucht.
Aus

For k = 1 To 4
'Import einer leeren Datei
If FileLen(pfad1 & k & "'_'" & enddatum2 & "'.csv") = 0 Then
Set ws = ActiveWorkbook.Sheets("R" & k)
Worksheets(k + 1).Activate
Call nodata
'Import einer nicht leeren Datei
Else
Set ws = ActiveWorkbook.Sheets("R" & k)
Worksheets("R" & k).Activate
Zeilenzahl = Selection.CurrentRegion.Rows.Count
With ws.QueryTables.Add(Connection:="TEXT;" & pfad1 & k & "'_'" & enddatum2 & "' _
.csv", Destination:=ws.Range("B" & Zeilenzahl + 1))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
End If
Next
Private Sub nodata()
Range("B1").Select
Zeilenzahl = Selection.CurrentRegion.Rows.Count
Range("B" & Zeilenzahl + 1).Value = "keine Daten"
Range("C" & Zeilenzahl + 1).Value = "von"
Range("D" & Zeilenzahl + 1).Value = enddatum - 1
Range("E" & Zeilenzahl + 1).Value = "6 Uhr früh"
Range("F" & Zeilenzahl + 1).Value = "bis"
Range("G" & Zeilenzahl + 1).Value = enddatum
Range("H" & Zeilenzahl + 1).Value = "6 Uhr"
Range("I" & Zeilenzahl + 1).Value = "früh"
End Sub
wurde
        For k = 1 To 4
'Import einer leeren Datei
If FileLen(pfad1 & k & "'_'" & enddatum2 & "'.csv") = 0 Then
Set ws = ActiveWorkbook.Sheets("R" & k)
Call nodata
'Import einer nicht leeren Datei
Else
Set ws = ActiveWorkbook.Sheets("R" & k)
ActiveWorkbook.Sheets(k+1).Range("B1").Select
Zeilenzahl = Selection.CurrentRegion.Rows.Count
With ws.QueryTables.Add(Connection:="TEXT;" & pfad1 & k & "'_'" & enddatum2 & "' _
.csv", Destination:=ws.Range("B" & Zeilenzahl + 1))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
End If
Next
Private Sub nodata()
ActiveWorkbook.Sheets(k).Range("B1").Select
Zeilenzahl = Selection.CurrentRegion.Rows.Count
ActiveWorkbook.Sheets(k+1).Range("B" & Zeilenzahl + 1).Value = "keine Daten"
ActiveWorkbook.Sheets(k+1).Range("C" & Zeilenzahl + 1).Value = "von"
ActiveWorkbook.Sheets(k+1).Range("D" & Zeilenzahl + 1).Value = enddatum - 1
ActiveWorkbook.Sheets(k+1).Range("E" & Zeilenzahl + 1).Value = "6 Uhr früh"
ActiveWorkbook.Sheets(k+1).Range("F" & Zeilenzahl + 1).Value = "bis"
ActiveWorkbook.Sheets(k+1).Range("G" & Zeilenzahl + 1).Value = enddatum
ActiveWorkbook.Sheets(k+1).Range("H" & Zeilenzahl + 1).Value = "6 Uhr"
ActiveWorkbook.Sheets(k+1).Range("I" & Zeilenzahl + 1).Value = "früh"
End Sub
Natürlich nimmt er die Befehle nicht an, weder mit Worksheets(k+1) noch mit der angegebenen Variante.
evtl benötigte Infos:
die Sheets heißen (ab Sheet 2) R1, R2, R3, R4, R5
es gibt noch ein weiteres Sheet (Sheet 7) was für das Makro aber keine Rolle spielt.
und ja ich weiß da ist der Import nur von R1 bis R4, ist auch hier so gewollt.
Und bei der Formatierung (3. Schritt des Makros, habe ich es auch nicht hinbekommen.
    For i = 2 To 6
Worksheets(i).Activate
Application.DisplayAlerts = True
zeilen = Cells(Rows.Count, 2).End(xlUp).Row
Range("A1").Value = "Barcode"
Columns("A:A").ColumnWidth = 9.71
Range("B1").Value = "Masterbarcode"
Columns("B:B").ColumnWidth = 15.57
Range("C1").Value = "anzPanel"
Columns("C:C").ColumnWidth = 10.29
Range("D1").Value = "DatumREHM"
Columns("D:D").ColumnWidth = 14.43
Range("E1").Value = "DiffTsec_zu_ECU_vorher"
Columns("E:E").ColumnWidth = 24
Range("F1").Value = "Schicht"
Columns("F:F").ColumnWidth = 8.57
Range("G1").Value = "BTname"
Columns("G:G").ColumnWidth = 9.43
Range("H1").Value = "irepcode"
Columns("H:H").ColumnWidth = 10.14
Range("I1").Value = "crepcode"
Columns("I:I").ColumnWidth = 38.86
Range("J1").Value = "PIN"
Columns("J:J").ColumnWidth = 5.43
Range("K1").Value = "AnalyseTyp"
Columns("K:K").ColumnWidth = 12.43
Range("L1").Value = "LIBname"
Columns("L:L").ColumnWidth = 18.86
Range("A1:L1").Font.Bold = True
For k = 2 To zeilen
barcode = Range("B" & k).Value
Range("A" & k).Value = Left(barcode, 4)
Next k
'Filter aktivieren
If ActiveSheet.AutoFilterMode Then
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
Else
Rows(1).AutoFilter
End If
Next
Freundliche Grüße und danke im Voraus!
Burak

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sheets befüllen ohne Öffnen
03.01.2018 08:55:56
Sepp
Hallo Burak,
du solltest dir angewöhnen, deine Variablen zu deklarieren!
Und poste in Zukunft nur komplette Prozeduren!
Ungetestet!
For k = 1 To 4
  'Import einer leeren Datei
  If FileLen(pfad1 & k & "'_'" & enddatum2 & "'.csv") = 0 Then
    Set ws = ActiveWorkbook.Sheets("R" & k)
    Call nodata
    
    'Import einer nicht leeren Datei
  Else
    Set ws = ActiveWorkbook.Sheets("R" & k)
    
    Zeilenzahl = ActiveWorkbook.Sheets(k + 1).Range("B1").CurrentRegion.Rows.Count
    With ws.QueryTables.Add(Connection:="TEXT;" & pfad1 & k & "'_'" & _
        enddatum2 & "'.csv", Destination:=ws.Range("B" & Zeilenzahl + 1))
      .TextFileParseType = xlDelimited
      .TextFileCommaDelimiter = True
      .Refresh
    End With
  End If
Next

Private Sub nodata()
Zeilenzahl = ActiveWorkbook.Sheets(k).Range("B1").CurrentRegion.Rows.Count
With ActiveWorkbook.Sheets(k + 1)
  .Range("B" & Zeilenzahl + 1).Value = "keine Daten"
  .Range("C" & Zeilenzahl + 1).Value = "von"
  .Range("D" & Zeilenzahl + 1).Value = enddatum - 1
  .Range("E" & Zeilenzahl + 1).Value = "6 Uhr früh"
  .Range("F" & Zeilenzahl + 1).Value = "bis"
  .Range("G" & Zeilenzahl + 1).Value = enddatum
  .Range("H" & Zeilenzahl + 1).Value = "6 Uhr"
  .Range("I" & Zeilenzahl + 1).Value = "früh"
End With
End Sub

For i = 2 To 6
  With Worksheets(i)
    zeilen = .Cells(Rows.Count, 2).End(xlUp).Row
    .Range("A1").Value = "Barcode"
    .Columns("A:A").ColumnWidth = 9.71
    .Range("B1").Value = "Masterbarcode"
    .Columns("B:B").ColumnWidth = 15.57
    .Range("C1").Value = "anzPanel"
    .Columns("C:C").ColumnWidth = 10.29
    .Range("D1").Value = "DatumREHM"
    .Columns("D:D").ColumnWidth = 14.43
    .Range("E1").Value = "DiffTsec_zu_ECU_vorher"
    .Columns("E:E").ColumnWidth = 24
    .Range("F1").Value = "Schicht"
    .Columns("F:F").ColumnWidth = 8.57
    .Range("G1").Value = "BTname"
    .Columns("G:G").ColumnWidth = 9.43
    .Range("H1").Value = "irepcode"
    .Columns("H:H").ColumnWidth = 10.14
    .Range("I1").Value = "crepcode"
    .Columns("I:I").ColumnWidth = 38.86
    .Range("J1").Value = "PIN"
    .Columns("J:J").ColumnWidth = 5.43
    .Range("K1").Value = "AnalyseTyp"
    .Columns("K:K").ColumnWidth = 12.43
    .Range("L1").Value = "LIBname"
    .Columns("L:L").ColumnWidth = 18.86
    .Range("A1:L1").Font.Bold = True
    For k = 2 To zeilen
      barcode = .Range("B" & k).Value
      .Range("A" & k).Value = Left(barcode, 4)
    Next k
    
    'Filter aktivieren
    If .AutoFilterMode Then
      If .FilterMode Then .ShowAllData
    Else
      .Rows(1).AutoFilter
    End If
  End With
Next

Gruß Sepp

Anzeige
AW: Sheets befüllen ohne Öffnen
03.01.2018 10:19:00
Burak
Tach Sepp und erstmal danke!
hat in soweit geklappt, natürlich ist jetzt da ein Fehler aufgetaucht, wo ich versucht habe deine gegebenen Infos für das 6. Tabellenblatt (R5) zu übertragen.
Diesmal der gesamte Code:

Dim enddatum As Date
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim importdatei
Dim pfad1 As String
Dim pfad2 As String
Dim barcode As String
Dim zeilen As Long
Dim startdatum As Date
Dim startdatum2 As String
Dim enddatum2 As String
Dim starttag As String
Dim startmonat As String
Dim startjahr As String
Dim endtag As String
Dim endmonat As String
Dim endjahr As String
Dim Zeilenzahl As Long
Dim tage As Integer
Dim i As Long
Dim k As Long
'Von-Datum
If Me.TextBox1.Value  "" Then
If Not IsDate(Me.TextBox1.Value) Then
MsgBox "Sie müssen ein Startdatum erfassen (dd.mm.yyyy) oder " & _
"per Klick aus dem Kalender auswählen.", _
48, "   Hinweis für " & Application.UserName
With Me.TextBox1
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
Exit Sub
End If
Else
MsgBox "Sie müssen ein Startdatum erfassen (dd.mm.yyyy) oder " & _
"per Klick aus dem Kalender auswählen.", _
48, "   Hinweis für " & Application.UserName
Me.TextBox1.SetFocus
Exit Sub
End If
'Bis-Datum
If Me.TextBox2  "" Then
If Not IsNumeric(Me.TextBox2.Value) Then
MsgBox "Sie müssen ein Enddatum erfassen (dd.mm.yyyy) oder " & _
"per Klick aus dem Kalender auswählen.", _
48, "   Hinweis für " & Application.UserName
With Me.TextBox2
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
Exit Sub
End If
Else
MsgBox "Sie müssen ein Enddatum erfassen (dd.mm.yyyy) oder " & _
"per Klick aus dem Kalender auswählen.", _
48, "   Hinweis für " & Application.UserName
Me.TextBox2.SetFocus
Exit Sub
End If
'Import für Pfadermittlung
importdatei = Application.GetOpenFilename
Do Until importdatei  "Falsch"
importdatei = Application.GetOpenFilename
Loop
pfad1 = Left(importdatei, InStrRev(importdatei, "_") - 3)
pfad2 = Right(importdatei, 15)
'Start- und Enddatum aus TextBoxen auslesen
startdatum = Me.TextBox1.Value
enddatum = Me.TextBox2.Value
startjahr = Right(startdatum, 4)
startmonat = Mid(startdatum, 4, 2)
starttag = Left(startdatum, 2)
startdatum2 = startjahr & startmonat & starttag
tage = enddatum - startdatum
'Alle Tabellenblätter clearen
For i = 2 To Worksheets.Count
With Worksheets(i)
.Cells.Clear
If .ChartObjects.Count > 0 Then
.ChartObjects.Delete
End If
End With
Next
'Import anhand Datum
For i = tage To 0 Step -1
enddatum = enddatum - i
hilfsvariableend = Left(enddatum, 5)
endjahr = Right(enddatum, 4)
endmonat = Mid(enddatum, 4, 2)
endtag = Left(enddatum, 2)
enddatum2 = endjahr & endmonat & endtag
'1-4
For k = 1 To 4
'Import einer leeren Datei
If FileLen(pfad1 & k & "'_'" & enddatum2 & "'.csv") = 0 Then
Set ws = ActiveWorkbook.Sheets("R" & k)
Call nodata
'Import einer nicht leeren Datei
Else
Set ws = ActiveWorkbook.Sheets("R" & k)
Zeilenzahl = ActiveWorkbook.Sheets(k + 1).Range("B1").CurrentRegion.Rows.Count
With ws.QueryTables.Add(Connection:="TEXT;" & pfad1 & k & "'_'" & enddatum2 & "' _
.csv", Destination:=ws.Range("B" & Zeilenzahl + 1))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
End If
Next
'6
Import einer leeren Datei
If FileLen(pfad1 & "6'_'" & enddatum2 & "'.csv") = 0 Then
Set ws = ActiveWorkbook.Sheets("R5")
Call nodata
'Import einer nicht leeren Datei
Else
Set ws = ActiveWorkbook.Sheets("R5")
Fehler ->   ActiveWorkbook.Sheets(5).Range("B1").Select
Zeilenzahl = ActiveWorkbook.Sheets(6).Range("B1").CurrentRegion.Rows.Count
With ws.QueryTables.Add(Connection:="TEXT;" & pfad1 & "6'_'" & enddatum2 & "'.csv",  _
Destination:=ws.Range("B" & Zeilenzahl + 1))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
End If
enddatum = enddatum + i
Next
'Formatierung sämtlicher Arbeitsblätter
For i = 2 To 6
With Worksheets(i)
zeilen = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("A1").Value = "Barcode"
.Columns("A:A").ColumnWidth = 9.71
.Range("B1").Value = "Masterbarcode"
.Columns("B:B").ColumnWidth = 15.57
.Range("C1").Value = "anzPanel"
.Columns("C:C").ColumnWidth = 10.29
.Range("D1").Value = "DatumREHM"
.Columns("D:D").ColumnWidth = 14.43
.Range("E1").Value = "DiffTsec_zu_ECU_vorher"
.Columns("E:E").ColumnWidth = 24
.Range("F1").Value = "Schicht"
.Columns("F:F").ColumnWidth = 8.57
.Range("G1").Value = "BTname"
.Columns("G:G").ColumnWidth = 9.43
.Range("H1").Value = "irepcode"
.Columns("H:H").ColumnWidth = 10.14
.Range("I1").Value = "crepcode"
.Columns("I:I").ColumnWidth = 38.86
.Range("J1").Value = "PIN"
.Columns("J:J").ColumnWidth = 5.43
.Range("K1").Value = "AnalyseTyp"
.Columns("K:K").ColumnWidth = 12.43
.Range("L1").Value = "LIBname"
.Columns("L:L").ColumnWidth = 18.86
.Range("A1:L1").Font.Bold = True
For k = 2 To zeilen
barcode = .Range("B" & k).Value
.Range("A" & k).Value = Left(barcode, 4)
Next k
'Filter aktivieren
If .AutoFilterMode Then
If .FilterMode Then .ShowAllData
Else
.Rows(1).AutoFilter
End If
End With
Next
Worksheets("Import starten").Activate
MsgBox "Erfolgreich kopiert!"
Unload Datumseingabe
End Sub
Private Sub Image1_Click()
Unload Datumseingabe
End Sub
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Kalender2.Show
End Sub
Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Kalender1.Show
End Sub
Private Sub nodata()
Zeilenzahl = ActiveWorkbook.Sheets(k).Range("B1").CurrentRegion.Rows.Count
With ActiveWorkbook.Sheets(k + 1)
.Range("B" & Zeilenzahl + 1).Value = "keine Daten"
.Range("C" & Zeilenzahl + 1).Value = "von"
.Range("D" & Zeilenzahl + 1).Value = enddatum - 1
.Range("E" & Zeilenzahl + 1).Value = "6 Uhr früh"
.Range("F" & Zeilenzahl + 1).Value = "bis"
.Range("G" & Zeilenzahl + 1).Value = enddatum
.Range("H" & Zeilenzahl + 1).Value = "6 Uhr"
.Range("I" & Zeilenzahl + 1).Value = "früh"
End With
End Sub
Kannst du mir evtl auch ne kurze Erklärugn dazu geben?
Danke
Anzeige
AW: Sheets befüllen ohne Öffnen
03.01.2018 10:32:29
Sepp
Hallo Burak,
Dim enddatum As Date

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim importdatei
Dim pfad1 As String
Dim pfad2 As String
Dim barcode As String
Dim zeilen As Long
Dim startdatum As Date
Dim startdatum2 As String
Dim enddatum2 As String
Dim starttag As String
Dim startmonat As String
Dim startjahr As String
Dim endtag As String
Dim endmonat As String
Dim endjahr As String
Dim Zeilenzahl As Long
Dim tage As Integer
Dim i As Long
Dim k As Long


'Von-Datum
If Me.TextBox1.Value <> "" Then
  If Not IsDate(Me.TextBox1.Value) Then
    MsgBox "Sie müssen ein Startdatum erfassen (dd.mm.yyyy) oder " & _
      "per Klick aus dem Kalender auswählen.", _
      48, " Hinweis für " & Application.UserName
    With Me.TextBox1
      .SetFocus
      .SelStart = 0
      .SelLength = Len(.Text)
    End With
    Exit Sub
  End If
Else
  MsgBox "Sie müssen ein Startdatum erfassen (dd.mm.yyyy) oder " & _
    "per Klick aus dem Kalender auswählen.", _
    48, " Hinweis für " & Application.UserName
  Me.TextBox1.SetFocus
  Exit Sub
End If

'Bis-Datum
If Me.TextBox2 <> "" Then
  If Not IsNumeric(Me.TextBox2.Value) Then
    MsgBox "Sie müssen ein Enddatum erfassen (dd.mm.yyyy) oder " & _
      "per Klick aus dem Kalender auswählen.", _
      48, " Hinweis für " & Application.UserName
    With Me.TextBox2
      .SetFocus
      .SelStart = 0
      .SelLength = Len(.Text)
    End With
    Exit Sub
  End If
Else
  MsgBox "Sie müssen ein Enddatum erfassen (dd.mm.yyyy) oder " & _
    "per Klick aus dem Kalender auswählen.", _
    48, " Hinweis für " & Application.UserName
  Me.TextBox2.SetFocus
  Exit Sub
End If

'Import für Pfadermittlung
importdatei = Application.GetOpenFilename
Do Until importdatei <> "Falsch"
  importdatei = Application.GetOpenFilename
Loop
pfad1 = Left(importdatei, InStrRev(importdatei, "_") - 3)
pfad2 = Right(importdatei, 15)

'Start- und Enddatum aus TextBoxen auslesen
startdatum = Me.TextBox1.Value
enddatum = Me.TextBox2.Value
startjahr = Right(startdatum, 4)
startmonat = Mid(startdatum, 4, 2)
starttag = Left(startdatum, 2)
startdatum2 = startjahr & startmonat & starttag
tage = enddatum - startdatum

'Alle Tabellenblätter clearen
For i = 2 To Worksheets.Count
  With Worksheets(i)
    .Cells.Clear
    If .ChartObjects.Count > 0 Then
      .ChartObjects.Delete
    End If
  End With
Next

'Import anhand Datum
For i = tage To 0 Step -1
  enddatum = enddatum - i
  hilfsvariableend = Left(enddatum, 5)
  endjahr = Right(enddatum, 4)
  endmonat = Mid(enddatum, 4, 2)
  endtag = Left(enddatum, 2)
  enddatum2 = endjahr & endmonat & endtag
  '1-4
  For k = 1 To 4
    'Import einer leeren Datei
    If FileLen(pfad1 & k & "'_'" & enddatum2 & "'.csv") = 0 Then
      Set ws = ActiveWorkbook.Sheets("R" & k)
      Call nodata(ws)
      
      'Import einer nicht leeren Datei
    Else
      Set ws = ActiveWorkbook.Sheets("R" & k)
      Zeilenzahl = ws.Range("B1").CurrentRegion.Rows.Count
      With ws.QueryTables.Add(Connection:="TEXT;" & pfad1 & k & "'_'" & _
          enddatum2 & "'.csv", Destination:=ws.Range("B" & Zeilenzahl + 1))
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .Refresh
      End With
    End If
  Next
  
  '6
  'Import einer leeren Datei
  If FileLen(pfad1 & "6'_'" & enddatum2 & "'.csv") = 0 Then
    Set ws = ActiveWorkbook.Sheets("R5")
    Call nodata(ws)
    
    'Import einer nicht leeren Datei
  Else
    Set ws = ActiveWorkbook.Sheets("R5")
    Zeilenzahl = ws.Range("B1").CurrentRegion.Rows.Count
    With ws.QueryTables.Add(Connection:="TEXT;" & pfad1 & "6'_'" & enddatum2 & _
        "'.csv", Destination:=ws.Range("B" & Zeilenzahl + 1))
      .TextFileParseType = xlDelimited
      .TextFileCommaDelimiter = True
      .Refresh
    End With
  End If
  enddatum = enddatum + i
Next

'Formatierung sämtlicher Arbeitsblätter
For i = 2 To 6
  With Worksheets(i)
    zeilen = .Cells(Rows.Count, 2).End(xlUp).Row
    .Range("A1").Value = "Barcode"
    .Columns("A:A").ColumnWidth = 9.71
    .Range("B1").Value = "Masterbarcode"
    .Columns("B:B").ColumnWidth = 15.57
    .Range("C1").Value = "anzPanel"
    .Columns("C:C").ColumnWidth = 10.29
    .Range("D1").Value = "DatumREHM"
    .Columns("D:D").ColumnWidth = 14.43
    .Range("E1").Value = "DiffTsec_zu_ECU_vorher"
    .Columns("E:E").ColumnWidth = 24
    .Range("F1").Value = "Schicht"
    .Columns("F:F").ColumnWidth = 8.57
    .Range("G1").Value = "BTname"
    .Columns("G:G").ColumnWidth = 9.43
    .Range("H1").Value = "irepcode"
    .Columns("H:H").ColumnWidth = 10.14
    .Range("I1").Value = "crepcode"
    .Columns("I:I").ColumnWidth = 38.86
    .Range("J1").Value = "PIN"
    .Columns("J:J").ColumnWidth = 5.43
    .Range("K1").Value = "AnalyseTyp"
    .Columns("K:K").ColumnWidth = 12.43
    .Range("L1").Value = "LIBname"
    .Columns("L:L").ColumnWidth = 18.86
    .Range("A1:L1").Font.Bold = True
    For k = 2 To zeilen
      barcode = .Range("B" & k).Value
      .Range("A" & k).Value = Left(barcode, 4)
    Next k
    
    'Filter aktivieren
    If .AutoFilterMode Then
      If .FilterMode Then .ShowAllData
    Else
      .Rows(1).AutoFilter
    End If
  End With
Next

Worksheets("Import starten").Activate
MsgBox "Erfolgreich kopiert!"
Unload Datumseingabe
End Sub

Private Sub Image1_Click()

Unload Datumseingabe

End Sub

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Kalender2.Show

End Sub

Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Kalender1.Show

End Sub

Private Sub nodata(ByVal vobjWorksheet As Worksheet)
With vobjWorksheet
  Zeilenzahl = .Range("B1").CurrentRegion.Rows.Count
  .Range("B" & Zeilenzahl + 1).Value = "keine Daten"
  .Range("C" & Zeilenzahl + 1).Value = "von"
  .Range("D" & Zeilenzahl + 1).Value = enddatum - 1
  .Range("E" & Zeilenzahl + 1).Value = "6 Uhr früh"
  .Range("F" & Zeilenzahl + 1).Value = "bis"
  .Range("G" & Zeilenzahl + 1).Value = enddatum
  .Range("H" & Zeilenzahl + 1).Value = "6 Uhr"
  .Range("I" & Zeilenzahl + 1).Value = "früh"
End With

End Sub


Zu erklären ist da nicht viel. Überall wo du vorher mit ActiveSheet, .Activate oder .Select gearbeitet hast, wird jetzt direkt referenziert. Bei der Sub 'nodata' wird das entsprechende Tabellenblatt nun als Parameter übergeben.
Gruß Sepp

Anzeige
AW: Sheets befüllen ohne Öffnen
03.01.2018 10:37:59
Burak
da kommt der Fehler: wenn er "Call nodata" ausführen will "Argument ist nicht optional"
AW: Sheets befüllen ohne Öffnen
03.01.2018 10:42:58
Sepp
Hallo Burak,
es muss nun ja auch 'Call nodata(ws)' lauten, da das Tabellenblatt als Argument übergeben wird!
Gruß Sepp

AW: Sheets befüllen ohne Öffnen
03.01.2018 10:48:58
Burak
ja was soll ich sagen, ich mach lieber Feierabend für heute. Scheinbar ist das Gehirn nach dem Urlaub noch nicht wieder an.
Läuft jetzt alles so wie gewollt. Danke dir :)
AW: Sheets befüllen ohne Öffnen
03.01.2018 10:34:22
Burak
vergiss es, weiß nich ob ich zu dumm oder zu blind war^^ die Zeile muss ja weg
aber mit dem nodata Sub gibt es noch ein Problem.
Zuerst hat er den Befehl aufgrund der Variable k nicht ausgeführt, nachdem ich k als globale Variable deklariert habe, hat es geklappt, aber er schreibt es immer in Zeile 2 statt ans Ende der Liste wie gedacht.
Idee?
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige