1 asked in 電腦與網際網路軟體 · 5 years ago

如何使用VBA下移一列

請問如何能夠在篩選後,將第1筆也就是A338:K338複製到工作表2,將第2筆A395:K395複製到工作表3,由於資料是不連續的,直接下移沒辦法到所需的位置,麻煩一下,謝謝.http://www.funp.net/144745

Update:

好複雜,真是個笨蛋,看個半天看不懂.之前看過那個網頁,再看還是看不懂,不是只是下移,怎麼那麼複雜

Update 2:

試了一下,請教一下先生,若依不才所需,1.若只要跑2次.2.若只要複製排名(在其前後各加其他數字,發現會複製整列),以上,敬請賜教.

Update 3:

很好用,請淮大上答,也感謝S大提供資料,以及先生大的範例

Update 4:

恩,那麻煩各位大大提出不同解法,讓小弟學習學習才不會老是上來問人,沒辦法幫人家,謝謝.

3 Answers

Rating
  • 5 years ago
    Favorite Answer

    UsedRange 並不表示是〔篩選區〕,

    有時標題列之上還有〔表首〕文字.項目或統計公式,

    可用 AutoFilter.Range 去抓篩選區,

    本題為例,篩選區為〔L1:M1213〕。

    2015-07-29 09:45:59 補充:

    With ActiveSheet

      If .FilterMode = False Then Exit Sub

      For Each xR In .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)

       If N > 2 Then Exit For '只貼前兩筆

       If N > 0 Then [A1:K1].Offset(xR.Row - 1, 0).Copy Sheets("工作表" & N + 1).[A1]

       N = N + 1

      Next

    End With

    2015-07-30 18:25:01 補充:

    EXCEL VBA.複製〔篩選區〕資料,逐列複製

                             <.准提部林.>

    ---------------------------------

    ■程式碼:

    Sub TEST02()

    Dim xR As Range, N%

    With ActiveSheet

      If .FilterMode = False Then Exit Sub '未執行篩選,跳出

      For Each xR In .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)

       If N > 2 Then Exit For  '只貼前兩筆

       If N > 0 Then [A1:K1].Offset(xR.Row - 1, 0).Copy Sheets("工作表" & N + 1).[A1]

       N = N + 1

      Next

    End With

    End Sub

     

    --說明--

    AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)

    取得〔篩選區〕的〔第1欄〕〔可見儲存格〕,

    這包含〔第1列〕的標題,所以,迴圈從第2筆開啟貼資料。

    ---------------------------------

    2015-07-30 18:27:25 補充:

    不好再推誠意,

    還是撥個空簡單貼答!

    • Commenter avatarLogin to reply the answers
  • 5 years ago

    期待准提部林大師解答...小弟也想學習

    MsgBox theRow.Row theRow.Address既然可以找出列號跟範圍就可以複製了

    theRow.Address.copy sheets(i).(位置)

    rows(theRow.Row ).copy sheets(i).(位置)

    2015-07-28 20:24:46 補充:

    不然就做苦工>>新增一個輔助Sheets就容易處理了

    Sheets("來源").UsedRange.AutoFilter Field:=2, Criteria1:=篩選

    Sheets("來源").UsedRange.Copy Sheets("輔助頁").Cells(1, 1)

    2015-07-28 21:32:55 補充:

    利用該網頁資料做個範例

    http://www.FunP.Net/624145

    • Commenter avatarLogin to reply the answers
  • 5 years ago

    參考一下

    http://blog.xuite.net/crdotlin/excel/11049893-Auto...

    2015-07-28 12:18:30 補充:

    For Each theRow In theArea.Rows

    theRow.Select '選定此列

    MsgBox theRow.Row '顯示此列

    Next

    • Commenter avatarLogin to reply the answers
Still have questions? Get your answers by asking now.