Hallo an alle Excelfreunde,
ich habe ein Code zusammengeschustert, teils mit Hilfe dieses Forums, soweit läuft dieser auch einwandfrei.
Jetzt soll dieser Code mithilfe einer UserForm gestartet werden; letztendlich soll er folgendes bewirken:
Man ruft eine UserForm auf, selektiert im aktiven Sheet eine oder mehrere Zeilen (von Spalte A bis Spalte X). Per CommandButton ruft man das Makro (welches ich hier erfrage) auf und Excel soll die Selektion in eine andere Excel Datei kopieren. Allerdings soll er von den markierten Spalte (A bis X) nur die Spalten A bis I, L bis R und W dessen Inhalte in die neue Datei an der nächsten freien Zeile kopieren. Die fehlenden Spalten, die nicht mitkopiert werden sollen, enthalten SVERWEISE die nicht mitkopiert werden sollen, da die Zieldatei an genau derselben Stelle die gleichen SVERWEISE enthält.
Hier der Code:
Private Sub soso()
Application.StatusBar = True
Application.StatusBar = "******D a t e n w e r d e n k o p i e r t !!!******"
Dim FNr As Long
Dim wks
Dim sFile As String
Dim lRow As Long
Dim intRow As Integer
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
sFile = "C:\neu.xls"
If Dir(sFile) = "" Then
MsgBox "Zieldatei wurde nicht gefunden !", vbCritical, "Warnung"
Exit Sub
End If
End With
On Error Resume Next
FNr = FreeFile
Open sFile For Binary Access Read Lock Read Write As #FNr
If Err.Number <> 0 Then
MsgBox "Die Zieldatei kann nicht geöffnet werden, versuchen Sie es später noch einmal !", vbInformation + vbOKOnly, "Hinweis"
Exit Sub
Else
Close #FNr
End If
Set wks = ActiveSheet
Workbooks.Open Filename:=sFile
Worksheets("ABB").Unprotect Password:="8840"
With Worksheets("ABB")
For intRow = 2 To 50
If WorksheetFunction.CountBlank(Rows(intRow)) < 256 Then
lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A" & intRow & ":X" & intRow).Copy
.Cells(lRow, 1).PasteSpecial Paste:=xlValues
End If
Next
Worksheets("ABB").Protect Password:="8840"
ActiveWorkbook.Close savechanges:=True
Application.ScreenUpdating = False
End With
Application.StatusBar = False
End Sub
PS: die For...Next Schleife muss so verändert werden, dass Excel die Selektion (wie oben beschrieben kopiert).
Vielen Dank im Voraus