Question

我特别需要将单元格从一张纸张复制到另一张纸张，从而复制而不是整行。只需将一个工作表中特定列中的数据复制到另一个工作表中的特定列。复制不是逐行进行，而是逐个单元进行，而不是以任何一个表中所示的顺序进行。例如。复制行＆＃34; A＆＃34;在表1到行＆＃34; D＆＃34;在表2中。

我在这里的代码效果很好除了我只想复制WITH DATA 行中的单元格并使用BLANK单元格跳过行。我想要一些帮助，在复制功能之前添加一行代码（＆＃34; D＆＃34;到＆＃34; X＆＃34;，＆＃34; O＆＃34;到＆＃34; Z＆＃ 34;等等）跳过带有空白单元格的行。

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

Answer 1

添加以下测试以跳过空单元格（以及导致0或“”的结果）

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

从一张纸到另一张纸，以随机列顺序选择性地复制[仅限空白单元格]

1 个答案: