Question

我的原始问题已发布here。

基本上我需要一些帮助，根据第一张表中的值将数据从一张纸转移到另一张。我正在使用用户keong kenshih提供的修改后的代码。

我在IF语句的另一行添加了额外的检查，我的代码中有这个：

Option Explicit
Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet
Dim MyOutputWorksheet As Worksheet

所以我只需要输出某些列。我还需要它们导入到第二张纸上的某些行和列，即合同表。 MAIN表上的A列从CONTRACT表的第17行开始到A列。 B到B，E到D，F到E，全部从合同单上的第17行开始。合同表上的第17-42行将包含数据。

Sub PullData()
    Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
    Set MyWorksheet = MyWorkbook.Sheets("MAIN")
    Set MyOutputWorksheet = MyWorkbook.Sheets("CONTRACT")

    Dim myValue As Long
    Dim RowPointer As Long

    For RowPointer = 6 To MyWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
        If MyWorksheet.Range("A" & RowPointer).V  alue > 0 And 
        MyWorksheet.Range("A" & RowPointer).Value <> "" 
        MyWorksheet.Range("F" & RowPointer).Value > 0 And 
        MyWorksheet.Range("F" & RowPointer).Value <> ""Then
            If MyOutputWorksheet.Cells(Rows.Count, "B").End(xlUp).Row > 15 
            Then
                Exit Sub
            End If
            MyWorksheet.Range(("A" & RowPointer) & ":C" & RowPointer).Copy 
            Destination:=MyOutputWorksheet.Range("A" & 
            MyOutputWorksheet.Cells(Rows.Count, "B").End(xlUp).Row + 1)
        End If
    Next RowPointer
End Sub

Answer 1

尝试一下：

Sub PullData()

Dim wRow As Long, _
    RowPointer As Long, _
    MyWorkbook As Workbook, _
    Ws As Worksheet, _
    OutWs As Worksheet

Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set Ws = MyWorkbook.Sheets("MAIN")
Set OutWs = MyWorkbook.Sheets("CONTRACT")

With Ws
    For RowPointer = 6 To .Cells(.Rows.Count, "B").End(xlUp).Row
        If .Range("A" & RowPointer).Value > 0 And _
                .Range("A" & RowPointer).Value <> "" And _
                .Range("F" & RowPointer).Value > 0 And _
                .Range("F" & RowPointer).Value <> "" Then
            'This line would get you out of the loop after the first copy because _
            'You first paste on line 17 and then the below left part will be equal to 18
            'If OutWs.Cells(OutWs.Rows.Count, "B").End(xlUp).Row > 15 Then Exit Sub


            wRow = OutWs.Rows(OutWs.Rows.Count).End(xlUp).Row + 1
            'Always start copy after (or at) line 17
            If wRow <= 17 Then wRow = 17
            'More efficient way to copy data between ranges
            OutWs.Range("A" & wRow).Value = Ws.Range("A" & RowPointer)
            OutWs.Range("B" & wRow).Value = Ws.Range("B" & RowPointer)
            OutWs.Range("D" & wRow).Value = Ws.Range("E" & RowPointer)
            OutWs.Range("E" & wRow).Value = Ws.Range("F" & RowPointer)
        End If
    Next RowPointer
End With

Set MyWorkbook = Nothing
Set Ws = Nothing
Set OutWs = Nothing

End Sub

在将数据从一个Excel工作表传输到另一个工作表时需要转置行

1 个答案: