Paste aus der Zwischenablage transponieren nicht leere Zelle

Question

i ein Makro möchten dauern Werte aus der Zwischenablage einfügen (Werte, die ich von einer anderen Quelle kopiert haben) in transponieren nicht leere Zelle in der Zeile E in Arbeitsblatt „Sheet1“

dauern

Hilfe?

Answer 1

function findLastRowInCol(wks as excel.worksheet, col as long) 
    dim rng as range 
    with wks 
     set rng = .cells(.rows.count, col).end(xlup) 
     findLastRowInCol = rng.row 
    end with 
end function 

aus dem Direkt-Bereich testen:

debug.print findLastRowInCol(thisworkbook.sheets("sheet1"), 5) 

Diese Ihnen in der angegebenen Spalte die Zeile der letzten nicht leeren Zelle geben. Beachten Sie, dass dies möglicherweise nicht die zuletzt verwendete Zeile des Arbeitsblatts ist. Wenn Sie eine andere Spalte auswählen, erhalten Sie abhängig von der letzten nicht leeren Zelle der Spalte ein anderes Ergebnis.

Edit: ersetzt Active mit „sheet1“

Edit: Beispielcode in einem anderen Makro zu verwenden, in von einer anderen Quelle einzufügen,

thisworkbook.sheets("sheet1").cells(findLastRowInCol(thisworkbook.sheets("sheet1"), 5), 5).pastespecial paste:=xlAll 

Wenn Einfügen aus einer anderen Excel-Tabelle oder die Formatierung abzuzustreifen , können Sie z „XlPasteSpecialValues“

Edited hinzufügen: eine Zeile aus einem anderen Arbeitsblatt einfügen und transponieren, verwenden Sie die oben so weit wie „.pastespecial“ dann ein paar Variationen auf:

.pastespecial paste:=xlpastevalues, transpose:=True 

Die einfachste Implementierung ist,

sub PasteToE() 
thisworkbook.sheets("sheet1").cells(findLastRowInCol(thisworkbook.sheets("sheet1"), 5),5).pastespecial paste:=xlpastevalues, transpose:=True 
end sub 

Fügen Sie dem anderen Arbeitsblatt eine Befehlsschaltfläche hinzu, und weisen Sie ihm dieses Makro zu. Wählen Sie Ihren Bereich und kopieren Sie ihn, und klicken Sie dann auf die Schaltfläche.

Answer 2

versuchen, etwas wie folgt aus:

Sub WriteFromClipboard() 
Dim refRow As Integer 
Dim Data As DataObject 
Dim DataText As String 
On Error Resume Next 
    'Get row to write data: 
    refRow = 1 + ThisWorkbook.Sheets("Sheet1").Columns(5).Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row 
    If Err.Number > 0 Then 
     refRow = 1 
    End If 
    Err.Clear 
    'Get data from clipboard: 
    Set Data = New DataObject 
    Data.GetFromClipboard 
    DataText = Data.GetText 
    'Write data from clipboard on the spreadsheet: 
    If Err.Number > 0 Then 
     MsgBox "Clipboard doesn't contain valid data." 
    Else 
     ThisWorkbook.Sheets("Sheet1").Cells(refRow, 5).Select 
     ThisWorkbook.Sheets("Sheet1").Paste 
    End If 
End Sub