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

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