时间戳

首页 > 解决方案 > 转置并粘贴到运行列表

excel - 转置并粘贴到运行列表

问题描述

我需要从工作表（“SCAN IN”）.column（“C2：ZZ”）上的表格中转置和粘贴数据并粘贴到工作表的最后一行（“SCAN IN2”）以创建运行列表。然后清除工作表上的表格（“SCAN IN”）

我已将表单设置为从工作表（“SCAN IN”）转置并清除目标工作表的内容，然后将数据粘贴到列（“C2：D”）中。

Sub Transfer_Transpose_Scans()
    Dim WksScanIn As Worksheet
    Dim rBinLocs As Range
    Dim rBinLoc As Range
    Dim iOutputRow As Long
    Dim iColOffset As Long
    Dim lastrow As Long


    ThisWorkbook.Activate
    Set WksScanIn = Worksheets("SCAN IN")
    On Error GoTo NoBinLocs
    Set rBinLocs = WksScanIn.Columns("C").Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
    On Error GoTo 0

    Worksheets("SCAN IN2").Activate
    Range("C2:D" & Rows.Count).ClearContents




    iOutputRow = 1

    For Each rBinLoc In rBinLocs
        iColOffset = 1
        While Len(rBinLoc.Offset(0, iColOffset).Value) > 1
            iOutputRow = iOutputRow + 1
            Cells(iOutputRow, "C").Value = rBinLoc.Value
            Cells(iOutputRow, "D").Value = rBinLoc.Offset(0, iColOffset).Value
            iColOffset = iColOffset + 1
        Wend
    Next rBinLoc

    Exit Sub
NoBinLocs:
    MsgBox "No bin locations found on " & """" & "SCAN IN" & """" & " worksheet Column c", vbInformation, "No Bin Locations Found"
End Sub

我需要从 Sheets("SCAN IN").column(C2:D) 复制、转置、粘贴到 ("SCAN IN2").column(c:d) 上表的最后一行。

我想清除从工作表（“扫描输入”）中转置和复制的数据。

标签： excelvba

解决方案

Sub Transfer_Transpose_Scans()
Dim WksScanIn As Worksheet
Dim rBinLocs As Range
Dim rBinLoc As Range
Dim iOutputRow As Long
Dim iColOffset As Long
Dim lastrow As Long


ThisWorkbook.Activate
Set WksScanIn = Worksheets("SCAN IN")
On Error GoTo NoBinLocs
Set rBinLocs = WksScanIn.Columns("C").Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo 0

Worksheets("SCAN IN2").Activate
'Range("C2:D" & Rows.Count).ClearContents

iOutputRow = Cells(Rows.Count, 3).End(xlUp).Row

For Each rBinLoc In rBinLocs
    iColOffset = 1
    While Len(rBinLoc.Offset(0, iColOffset).Value) > 1
        iOutputRow = iOutputRow + 1
        Cells(iOutputRow, "C").Value = rBinLoc.Value
        Cells(iOutputRow, "D").Value = rBinLoc.Offset(0, iColOffset).Value
        iColOffset = iColOffset + 1
    Wend
Next rBinLoc

WksScanIn.Range("C2:XFD" & Rows.Count).ClearContents

Exit Sub

推荐阅读