將行中的單元格復制並粘貼到不同的列中

Question

昨天我發布了郵件，並獲得了一些幫助，這使我開始嘗試做的事情，但不幸的是，我再次陷入困境。 我有調用要求一天的輸入框的代碼。 輸入日期后，它將在工作表中搜索包含該日期的單元格，然后將其復制/粘貼到另一工作表中。

我似乎無法弄清楚該怎么做，就是按照我需要的方式粘貼它。

到目前為止，這是我的代碼：

Private Sub Run_Report_Click()
Dim chdate As Date, datestring As String

datestring = Application.InputBox("Enter Date (MM/DD/YY)", "Date")

If IsDate(datestring) Then
    chdate = DateValue(datestring)
Else
    MsgBox "Invalid Date"
Exit Sub
End If

'input box pop up to allow user to search for
'a specific date

Application.ScreenUpdating = False
Dim xRow, NextRow, LastRow
LastRow = Cells(Rows.Count, 1).End(xlUp).Rows
NextRow = 2
For xRow = 2 To LastRow
    If InStr(Cells(xRow, 1).Value, chdate) > 0 Then
        Rows(xRow).Copy Sheets("TEMP").Rows(NextRow)
        NextRow = NextRow + 1
    End If
    Next xRow
Application.ScreenUpdating = True


MsgBox "Macro is complete, " & NextRow - 2 & " rows containing" & vbCrLf & _
"''" & chdate & "''" & " were copied to TEMP.", 64, "Done"
    End Sub

它從15個不同的列中提取數據，並按原樣粘貼指定的行。 但是，我不確定如何使它粘貼一些信息到不同行的同一列中。 有點像這樣。

1a 2a 3a 4a 5a 6a
1b 2b 3b 4b 5b 6b

至

1a 2a 6a
3A
4A
5A
1b 2b 6b
3B
4B
5B

然后從所選日期繼續處理其余數據。 任何幫助將不勝感激，謝謝。

Answer 1

使用以下代碼代替循環（可以保留輸入框代碼）。

Dim wsActive As Worksheet
Dim wsTemp As Worksheet
Dim nRowActive As Long
Dim nCounter As Long
Dim xRow As Long
Dim nRowToUse As Long

Const IADDEND As Integer = 2

Set wsActive = ActiveSheet
Set wsTemp = Sheets("TEMP")

nRowActive = wsActive.Cells(Rows.Count, 1).End(xlUp).Row
nCounter = 0

For xRow = 2 To nRowActive
    nRowToUse = nCounter * 4 + IADDEND
    wsTemp.Cells(nRowToUse, 1).Value = wsActive.Cells(xRow, 1).Value
    wsTemp.Cells(nRowToUse, 2).Value = wsActive.Cells(xRow, 2).Value
    wsTemp.Cells(nRowToUse + 1, 1).Value = wsActive.Cells(xRow, 3).Value
    wsTemp.Cells(nRowToUse + 2, 1).Value = wsActive.Cells(xRow, 4).Value
    wsTemp.Cells(nRowToUse + 3, 1).Value = wsActive.Cells(xRow, 5).Value
    wsTemp.Cells(nRowToUse, 3).Value = wsActive.Cells(xRow, 6).Value
    nCounter = nCounter + 1
Next xRow

讓我知道是否有幫助。