以随机列顺序选择性地将[非空白单元格]从一张纸复制到另一张纸 [英] Selectively copy [non-blank cells only] in random column order from one sheet to another

问题描述

我特别需要将单元格从一张纸复制到另一张纸，从而不复制整行.仅将一张纸中特定列中的数据复制到另一张纸中特定列中.复制不是逐行进行的，而是逐个单元地进行的，并且复制的顺序与任何一张纸中显示的顺序都不相同.例如.将工作表1中的"A"行复制到工作表2中的"D"行.

I have a specific need to copy cells from one sheet to another sheet whereby not the entire row is copied. Only data in specific columns in the one sheet needs to be copied to specific columns in the other sheet. Copying does not happen row by row but cell by cell and not in the same order as presented in either sheet . E.g. Copy ROW "A" in Sheet 1 to ROW "D" in Sheet 2.

我在这里拥有的代码非常有用，除了我只希望复制具有数据行的单元格，并跳过具有空白单元格的行.我想要一些帮助，在复制功能之前添加一行代码(从"D"到"X"，"O"到"Z"等)以跳过包含空白单元格的行.

The code I have here works great except I would like to ONLY copy cells in rows WITH DATA and SKIP the rows with BLANK cells. I would like some help adding a line of code that precedes the copy-functions ("D" to "X", "O" to "Z", etc.) to skip the rows with blank cells.

Sub Test()

Dim i As Long
Dim ii As Long
Dim i3 As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet

Set wb = ThisWorkbook
Set sht1 = wb.Sheets("DataValues")
Set sht2 = wb.Sheets("BEN")

Sheets("BEN").Select
Range("C192:P220").ClearContents

'Find the last row (in column X) with data in sheet ("DATAValues"). (LIMIT data to COLUMN Z)
LastRow = sht1.Range("Z9:Z37").Find("*", SearchDirection:=xlPrevious).Row

'Start copying data values in "BEN" starting at ROW "192" (due to other data located above)
ii = 192

'This is the beginning of the loop !!!
'Start at row 9 in DATAVALUES to last row with data

For i = 9 To LastRow

    'First activity
    'This is a MUST HAVE for my application

    sht2.Range("D" & ii) = sht1.Range("X" & i).Value
    sht2.Range("O" & ii) = sht1.Range("Z" & i).Value
    sht2.Range("K" & ii) = sht1.Range("AB" & i).Value
    sht2.Range("M" & ii) = sht1.Range("AD" & i).Value

    ii = ii + 1

Next i

End Sub

推荐答案

添加以下测试以跳过空单元格(以及那些导致0或"的单元格)

Add the following test to skip empty cells (and those resulting in 0 or "")

If Not IsEmpty(sht1.Range("Z" & i)) And sht1.Range("Z" & i) <> 0  And sht1.Range("Z" & i) <> vbNullString

请参见下文

Option Explicit

Sub Test()

    Dim i As Long
    Dim ii As Long
    Dim i3 As Long
    Dim LastRow As Long
    Dim wb As Workbook
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet

    Set wb = ThisWorkbook
    Set sht1 = wb.Sheets("DataValues")
    Set sht2 = wb.Sheets("BEN")

    With Sheets("BEN")

        .Range("C192:P220").ClearContents

        'Find the last row (in column X) with data in sheet ("DATAValues"). (LIMIT data to COLUMN Z)
        LastRow = sht1.Range("Z9:Z37").Find("*", SearchDirection:=xlPrevious).Row
        'Start copying data values in "BEN" starting at ROW "192" (due to other data located above)
        ii = 192

        'This is the beginning of the loop !!!
        'Start at row 9 in DATAVALUES to last row with data

        For i = 9 To LastRow

            'First activity
            'This is a MUST HAVE for my application
            If Not IsEmpty(sht1.Range("Z" & i)) And _
               sht1.Range("Z" & i) <> 0 And _
               sht1.Range("Z" & i) <> vbNullString Then

                sht2.Range("D" & ii) = sht1.Range("X" & i).Value
                sht2.Range("O" & ii) = sht1.Range("Z" & i).Value
                sht2.Range("K" & ii) = sht1.Range("AB" & i).Value
                sht2.Range("M" & ii) = sht1.Range("AD" & i).Value

            ii = ii + 1

            End If

        Next i  

    End With

End Sub

这篇关于以随机列顺序选择性地将[非空白单元格]从一张纸复制到另一张纸的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！