Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1132to1136
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

Makro funzt nicht so richtig

Makro funzt nicht so richtig
René
Hallo liebe Excelprofis,
kann mir jemand helfen mein Abslolut Beginners Makro zu optmieren. Habe mal an den Stellen wo es nicht so ist wie ich das will Bemerkungen eingeschrieben. Vielleicht könnt ihr mir einen Tipp geben. Würde mich freuen

Private Sub CommandButton1_Click()
Worksheets("Daten Kurzcheck roh").Visible = xlSheetVisible
Worksheets("Daten Kurzcheck aufbereitet").Visible = xlSheetVisible
Sheets("Daten Kurzcheck roh").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;O:\Technik\Daten.csv" _
, Destination:=Range("A2"))
.Name = "Daten_Kurzcheck"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,   _
_
_
1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Daten Kurzcheck roh").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Columns("D:D").Select
Selection.Copy
Sheets("Daten Kurzcheck aufbereitet").Select
Columns("D:D").Select
ActiveSheet.Paste
Sheets("Daten Kurzcheck roh").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Daten Kurzcheck aufbereitet").Select
Columns("A:A").Select
ActiveSheet.Paste
Range("E7").Select
Sheets("Daten Kurzcheck aufbereitet").Select
Worksheets("Daten Kurzcheck roh").Visible = xlSheetVeryHidden
Worksheets("Daten Kurzcheck aufbereitet").Visible = xlSheetVeryHidden
Dim actRow, DSNr As Long
If _
(Worksheets("Daten Kurzcheck roh").Cells(2, 1).Value = 0) Then Scannerdaten.Hide: Exit Sub
Hier würde ich aber gern wenn in Daten Kurzcheck die Zellen leer sind das Formular  _
Scannerdaten geschlossen wird und die Prozedur ganz unten (siehe letzte Zeile im Script) mit FormularWochenbericht.Show weitermacht 
Load ProgressDlg2
ProgressDlg2.Show
Dim a As Long, b As Long, c As Long
b = Sheets("Daten Kurzcheck aufbereitet").Cells(Rows.Count, 1).End(xlUp).Row
c = Sheets("Daten Kurzcheck").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Daten Kurzcheck aufbereitet").Rows("2:" & b).Copy
Sheets("Daten Kurzcheck").Rows(c).Insert
Sheets("Daten Kurzcheck aufbereitet").Rows("2:" & b).Clear
Hier bei der Zusammenführung der Daten aus der Tabelle DatenKurzcheck aufbereitet in die
Zieltabelle Daten Kurzcheck will ich das nur die Spalten von A bis X aus der Tabelle Daten  _
Kurzcheck aufbereitet geholt werden und die Spalten ab Spalte X in der Zieltabelle Daten Kurzcheck nicht überschrieben werden. 

b = Sheets("Daten Kurzcheck Formeln").Cells(Rows.Count, 3).End(xlUp).Row
c = Sheets("Daten Kurzcheck aufbereitet").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Daten Kurzcheck Formeln").Rows("2:" & b).Copy
Sheets("Daten Kurzcheck aufbereitet").Rows(c).Insert
Sheets("Daten Kurzcheck roh").Rows("2:" & b).Clear
Dim strFile As String
Dim ff As Integer
strFile = "O:\Technik\Daten.csv"
ff = FreeFile
Open strFile For Output As #ff
Print #ff, vbNullString
Close #ff
Scannerdaten.Hide
FormularWochenbericht.Show
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro funzt nicht so richtig
02.02.2010 12:21:56
fcs
Hallo René,
1.
Die Verzeigung machst du mit "GoTo" indem du vor der Zielzeile eine Sprungadresse einfügst oder aber du baust eine vollständige If-Konststruktion
If Bedingung Then
'Aktion
Else
'Aktion
End If
2.
dann muss du mit Range und Cells statt mit Rows arbeiten, um den Bereich auf bestimme Spalten zu begrenzen.
Gruß
Franz
Private Sub CommandButton1_Click()
Dim a As Long, b As Long, c As Long
Dim wksRoh As Worksheet, wksAufbereitet As Worksheet
Dim wksCheck As Worksheet, wksCheckFormel As Worksheet
Dim actRow, DSNr As Long
Set wksRoh = Worksheets("Daten Kurzcheck roh")
Set wksAufbereitet = Worksheets("Daten Kurzcheck aufbereitet")
Set wksCheck = Worksheets("Daten Kurzcheck")
Set wksCheckFormel = Worksheets("Daten Kurzcheck Formeln")
wksRoh.Visible = xlSheetVisible
wksAufbereitet.Visible = xlSheetVisible
wksRoh.Select
With wksRoh.QueryTables.Add(Connection:= _
"TEXT;O:\Technik\Daten.csv" _
, Destination:=Range("A2"))
.Name = "Daten_Kurzcheck"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
wksRoh.Rows("1:1").Delete Shift:=xlUp
wksRoh.Columns("D:D").Copy Destination:=wksAufbereitet.Columns("D:D")
wksRoh.Columns("A:A").Copy Destination:=wksAufbereitet.Columns("A:A")
wksAufbereitet.Select
wksRoh.Visible = xlSheetVeryHidden
wksAufbereitet.Visible = xlSheetVeryHidden
If (wksRoh.Cells(2, 1).Value = 0) Then
Scannerdaten.Hide
Else
Load ProgressDlg2
ProgressDlg2.Show
b = wksAufbereitet.Cells(Rows.Count, 1).End(xlUp).Row
c = wksCheck.Cells(Rows.Count, 1).End(xlUp).Row + 1
With wksAufbereitet
.Range(.Cells(2, 1), .Cells(b, 24)).Copy Destination:=wksCheck.Cells(c, 1)
.Rows("2:" & b).Clear
End With
'Hier bei der Zusammenführung der Daten aus der Tabelle DatenKurzcheck _
aufbereitet in die Zieltabelle Daten Kurzcheck will ich das nur die _
Spalten von A bis X aus der Tabelle Daten Kurzcheck aufbereitet geholt _
werden und die Spalten ab Spalte X in der Zieltabelle Daten Kurzcheck nicht _
überschrieben werden.
b = wksFormel.Cells(Rows.Count, 3).End(xlUp).Row
c = wksAufbereitet.Cells(Rows.Count, 1).End(xlUp).Row + 1
wksFormel.Rows("2:" & b).Copy
wksAufbereitet.Rows(c).Insert
wksRoh.Rows("2:" & b).Clear
Dim strFile As String
Dim ff As Integer
strFile = "O:\Technik\Daten.csv"
ff = FreeFile
Open strFile For Output As #ff
Print #ff, vbNullString
Close #ff
Scannerdaten.Hide
End If
FormularWochenbericht.Show
End Sub

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige