在Excel中自动复制和粘贴特定范围的最佳方法是什么？

我对VBA很新，有一个任务我想自动化，不知道从哪里开始。 我有一个如下所示的数据集。

样本数据

我想要做的是循环通过列A，如果它有东西（将始终是一个电子邮件）select所有行，直到再次有A列中的东西。 复制并粘贴到新标签。 所以2-5行将复制并粘贴到一个新的选项卡。 然后将第6-9行放入不同的新选项卡中。 第1行也会复制到每个标签。 我一直没能find代码来帮助这个特定的需求，任何帮助将不胜感激。

我发现这个代码，并开始修改它，但是，这是远不及我所需要的或为此工作。

Sub split() Dim rng As Range Dim row As Range Set rng = Range("A:A") For Each row In rng 'test if cell is empty If row.Value <> "" Then 'write to adjacent cell row.Select row.Copy Worksheets("Sheet2").Activate Range("A2").Select row.PasteSpecial Worksheets("Sheet1").Activate End If Next End Sub 

Answer 1

这段代码应该提供你所需要的：

 Sub Split() Dim wb As Workbook Set wb = ThisWorkbook Dim ws As Worksheet Set ws = wb.Worksheets(1) 'change sheet index or use Worksheets("Sheet1") method to use exact name Dim rngBegin As Range Dim rngEnd As Range With ws Dim rngHeader As Range Set rngHeader = .Range("A1:H1") 'to copy headers over each time Dim lRowFinal As Long lRowFinal = .Range("C" & .Rows.Count).End(xlUp).Row 'assumes eventually last row of needed data will have an address1 Set rngEnd = .Range("A1") ' to begin loop Set rngBegin = rngEnd.End(xlDown) 'to begin loop Do Set rngEnd = rngBegin.End(xlDown).Offset(-1) Dim wsNew As Worksheet Set wsNew = Worksheets.Add(After:=wb.Sheets(.Index))'always after current sheet, change as needed .Range(.Cells(rngBegin.Row, 1), .Cells(rngEnd.Row, 8)).Copy wsNew.Range("A2") wsNew.Range("A1:H1").Value = rngHeader.Value Set rngBegin = rngEnd.End(xlDown) Loop Until rngBegin.Row >= lRowFinal End With End Sub 

Answer 2

尝试将您的stream程分解成多个步骤，并确定如何进行的规则。 然后写出一些伪代码（类似于逻辑的代码），以确保一切正常。

1. 你需要某种循环，因为你要以相同的方式处理每一组行。
2. 您需要一些代码来确定每个块中包含的单元格
3. 代码块（由步骤2给出）并粘贴到一个新的选项卡。

您的伪代码可能如下所示：

 ' This is the main function that runs the whole routine Sub Main() Set headerRg = GetHeaderRg() Do Until IsAtTheEnd(startRow) = True Set oneBlock = GetNextBlock(startRow) Call ProcessBlock(oneBlock) startRow = startRow + oneBlock.Rows.Count Loop End Sub ' This function returns the header range to insert into the top Function GetHeaderRg() As Range ' Write some code here that returns the header range End Function ' This function determines whether we are at the end of our data Function IsAtTheEnd(current_row as Long) as Boolean ' Write some code here that determines whether we have hit the end of our data '(probably checks the first column to see if there is data) End Function ' This function takes the startRow of a block and returns the whole block of Rows Function GetNextBlock(startRow) As Range ' Write some code that returns the whole range you want to copy End Function ' This sub takes a range to be processed and a header to print and prints ' it into a new tab Sub ProcessBlock(BlockRg As Range, headerRg as Range) Set targetSheet = thisWorkbook.Sheets.Add() ' Write some code that pastes the headerRg and BlockRg where you want it End Sub 

如果您有更多关于语法的具体问题，我们将很乐意帮助您！