Question

我是一个完整的VBA新手，并不足以破解我在网上看到的一些解决方案。我希望一个大师可以推出一个快速的VBA循环，我可以玩它。

我只是想：

Copy every 3 rows from Sheet1. Paste 3 rows into new sheet (Sheet2).
Copy next 3 rows from Sheet1, and paste into another new sheet (Sheet 3).

我想循环此函数，直到行为空。

我已经记录了这个功能的VBA，它只运行一次。我需要它循环直到行为空。

    Sub countrySplit()
    '
        Sheets("vs Target").Select
        Range("A5:N5, A6:N8").Select
        Selection.Copy
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Select
        Range("A1").Select
        ActiveSheet.Paste
        ActiveSheet.Name = ActiveSheet.Range("$A$2")


End Sub

Answer 1

@JackC ......我就是这样做的...当然有很多方法但是如果你想要的话可以尝试一下。只需根据代码中的注释进行编辑即可调整工作簿，如果不这样做则不会将所有数据复制到新工作表中。

Sub loopTest()
Dim hdr As Range 'header range
Dim dta As Range 'data range
Dim cl As Integer 'copy line
Dim ns As Excel.Worksheet

Set hdr = Excel.Worksheets(1).Range("A1:C1") 'set this range for what ever range your headers are on
cl = 2 'set this value for what ever row your data starts on
Do While Excel.Worksheets(1).Range(Cells(cl, 1), Cells(cl, 1)).Value <> "" 'this stops the loop when there are no more records
Set dta = Excel.Worksheets(1).Range(Cells(cl, 1), Cells(cl + 2, 3)) 'this sets the data range change the number 3 to how ever many columns there are in your dataset
Set ns = Excel.Worksheets.Add(, ActiveSheet) 'this sets the new sheet to the ns (new sheet = ns ) variable
hdr.Copy
ns.Range("A1").PasteSpecial xlPasteAll
dta.Copy
ns.Range("A2").PasteSpecial xlPasteAll
cl = cl + 3
Loop

End Sub

循环复制/将每第N行粘贴到新工作表中？

1 个答案: