Leere Zeilen löschen
07.07.2019 13:15:24
walta
beim nachfolgenden Code habe ich einige Probleme die ich selbst nicht lösen kann.
- es werden alle Zellen ab A1:Z2000 kopiert ich brauche aber A2:ZZ2000, meine erste Zeile soll stehen bleiben
-alle Zeilen in denen nichts steht sollen gelöscht werden und die Daten damit alle direkt untereinander stehen
-die Daten sollen sortiert werden "Z bis A" also vom Größten zum kleinsten, das nach Spalte H (hier stehen die relevanten Werte nach denen sortiert werden muss)
Ich weiß, dass ich hier viel verlange, jedoch sitze ich schon eine Woche daran und komme leider nicht weiter.
Daher danke ich jedem, der mir hier weiterhelfen kann.
Option Explicit
Public Sub OpenFiles()
Const FILE_PATH As String = "C:\Users\WBICHOU\Desktop\projekt\"
Dim MyFile As String
Dim objWorkbook As Workbook
Dim lngRow As Long
Application.ScreenUpdating = False
Call ThisWorkbook.Worksheets("Sheet1").Cells.ClearContents
lngRow = 1
MyFile = Dir$(FILE_PATH & "*.xlsx")
Do Until MyFile = ""
If MyFile ThisWorkbook.Name Then
Set objWorkbook = Workbooks.Open(Filename:=FILE_PATH & MyFile, UpdateLinks:=3)
Call objWorkbook.Worksheets("Sheet1").Range("A2:ZZ2001").Copy( _
Destination:=ThisWorkbook.Worksheets("Sheet1").Cells(lngRow, 1))
lngRow = lngRow + 2000
Call objWorkbook.Close(SaveChanges:=True)
End If
MyFile = Dir$
Loop
With ThisWorkbook.Worksheets("Sheet1")
.Range(.Cells(.Rows.Count, 1).End(xlUp). _
Offset(1, 0), .Cells(.Rows.Count, 1)).EntireRow.Hidden = True
.Range(.Cells(1, .Columns.Count).End(xlToLeft). _
Offset(0, 1), .Cells(1, .Columns.Count)).EntireColumn.Hidden = True
End With
Application.ScreenUpdating = True
End Sub
Beste Grüße