Question

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

我已将表格设置为从工作表转置（“ 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）上表的最后一行。

我想清除从工作表（“ SCAN IN”）中转置和复制的数据。

Answer 1

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

转置并粘贴到运行列表

1 个答案: