Makro funzt nicht so richtig
René
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