Re(14): Here is the code....
Geizhals » Forum » Software » Excel - kopieren von nicht nebeneinander liegenden Zeilen (54 Beiträge, 1147 Mal gelesen) Top-100 | Fresh-100
Du bist nicht angemeldet. [ Login/Registrieren ]
...  Here is the code....  (lsr2 am 02.02.2018, 22:55:05)
....  Re: Here is the code....  (mitmiranet am 13.02.2018, 09:23:53)
.....  Re(2): Here is the code....  (klausiw am 13.02.2018, 09:48:09)
......  Re(3): Here is the code....  (mitmiranet am 13.02.2018, 15:49:38)
.......  Re(4): Here is the code....  (klausiw am 13.02.2018, 15:55:38)
........  Re(5): Here is the code....  (mitmiranet am 14.02.2018, 15:30:54)
.........  Re(6): Here is the code....  (klausiw am 14.02.2018, 16:24:59)
..........  Re(7): Here is the code....  (mitmiranet am 15.02.2018, 08:51:15)
...........  Re(8): Here is the code....  (lsr2 am 15.02.2018, 18:50:25)
............  Re(9): Here is the code....  (mitmiranet am 16.02.2018, 09:17:41)
.............  Re(10): Here is the code....
 (lsr2 am 16.02.2018, 16:34:27)
..............  Re(11): Here is the code....  (mitmiranet am 21.02.2018, 07:48:07)
...............  Re(12): Here is the code....
 (lsr2 am 23.02.2018, 21:32:06)
................  Re(13): Here is the code....  (lsr2 am 24.02.2018, 00:00:05)
................  Re(13): Here is the code....  (mitmiranet am 28.02.2018, 09:21:35)
.................
Re(14): Here is the code....
02.03.2018, 18:55:38
Ich hoffe dir geht es wieder besser!
Heute war wegen Schnee wieder mal sowieso alles verspaetet... :-/

Tierheim finde ich voll OK :-)

Bitte teste mal folgenden Code:


Public Sub runMe()
    'error handler definition
    On Error GoTo error_handler
    
    'define excel objects
    Dim wbWorkbook As Excel.Workbook
    Dim shSheet As Excel.Worksheet
    
    'set excel objects to currents
    Set wbWorkbook = ActiveWorkbook
    Set shSheet = ActiveSheet
    
    'first header row to include
    Dim iFirstHeaderRow As Integer
    iFirstHeaderRow = 2
    
    'last header row to include, start with <iFirstHeaderRow> to <iLastHeaderRow>
    Dim iLastHeaderRow As Integer
    iLastHeaderRow = 3
    
    'define column range
    Dim sFirstCol As String
    sFirstCol = "A"
    Dim sLastCol As String
    sLastCol = "T"
    
    'get last filled in row number
    Dim lLastNonemptyRow As Long
    lLastNonemptyRow = shSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    
    'prep outlook objects for creating mail to send
    Dim aOutlook As Outlook.Application
    Set aOutlook = New Outlook.Application
    Dim mMailItem As Outlook.MailItem
    Set mMailItem = aOutlook.CreateItem(olMailItem)
    Call mMailItem.Display 'only works with displayed mail

    Dim objdoc As Object
    Dim objsel As Word.Selection

    Set objdoc = aOutlook.ActiveInspector.WordEditor
    Set objsel = objdoc.Windows(1).Selection
    
    'funny thing ... this doesn't work as expected - you always get also the lines in between the multiple nonconsecutive selects *grml*
    'shSheet.Range("1:" & iLastHeaderRow & "," & lLastNonemptyRow & ":" & lLastNonemptyRow).EntireRow.Select
    'shSheet.Range("1:" & iLastHeaderRow & "," & lLastNonemptyRow & ":" & lLastNonemptyRow).EntireRow.Copy
    
    'copy and paste header row(s)
    shSheet.Range(sFirstCol & iFirstHeaderRow, sLastCol & iLastHeaderRow).Copy
    Call objsel.Paste
    
    'copy and paste last row (outlook automatically joins it to one table)
    shSheet.Range(sFirstCol & lLastNonemptyRow, sLastCol & lLastNonemptyRow).Copy
    Call objsel.Paste
    
    'explicit exit before running error handler
    Exit Sub
    
error_handler:
    Call MsgBox("Error: " & Err.Description, vbOKOnly + vbCritical, "Error " & Err.Number)

End Sub


Fuer mich brauch ich nix, danke. Ich hab alles was ich gern haette - und das was mir fehlt, kann man nicht kaufen und mir nicht schenken. Ich automatisier einfach gerne repetitive Dinge.


Antworten PM Alle Chronologisch Zum Vorgänger
 
Melden nicht möglich
..................  Re(15): Here is the code....  (mitmiranet am 19.03.2018, 08:25:06)
 

Dieses Forum ist eine frei zugängliche Diskussionsplattform.
Der Betreiber übernimmt keine Verantwortung für den Inhalt der Beiträge und behält sich das Recht vor, Beiträge mit rechtswidrigem oder anstößigem Inhalt zu löschen.
Datenschutzerklärung