使用宏从某行开始复制行直到结束

Question

我需要复制一个 excel 的值并创建一个具有所需格式的新值。假设我需要将列从 B11 复制到 BG11，行将一直到最后。（我不知道如何找到行的结尾）。我在 b7 到 bg7 中有列标题。中间有不需要的行，我不需要它。所以在新的 excel 中，我希望列标题（从 b7 到 bg7）作为第一行，从 b11 到 bg11 的值直到最后。

这是我的第一个 excel 宏。我不知道该怎么做。因此，通过一些 stackoverflow 问题和其他站点的引用，我尝试了以下代码。但它没有提供所需的输出。

Sub newFormat()

Dim LastRow As Integer, i As Integer, erow As Integer

LastRow = ActiveSheet.Range(“B” & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

Sheets("MySheetName").Range("B7:BG7").Copy
Sheets("MySheetName").Range("B11:BG11").Copy


Workbooks.Open Filename:=”C:\Users\abcd\Documents\Newformat.xlsx”
Worksheets(“Sheet1”).Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If

Next i
End Sub

这可能很简单。任何帮助将不胜感激。

Answer 1

几件事...

1. 不要将Integer 用于行。发布xl2007，行数增加了，Integer 无法容纳。使用Long

2. 您无需选择要粘贴的范围。您可以直接执行该操作。

3. 您不需要使用循环。您可以复制两个块中的范围

4. 使用对象，以免 Excel 被您的对象弄糊涂。

5. 由于Sheet1 为空，您无需在此处查找最后一行。只需从1 开始。

6. 要将数据输出到新工作簿，您必须使用Workbooks.Add

查看此示例（未经测试）

Sub newFormat()
    Dim wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet
    Dim LastRow As Long, erow As Long

    '~~> Set this to the relevant worksheet
    Set wsI = ThisWorkbook.Sheets("HW SI Upload")
    '~~> Find the last row in Col B
    LastRow = wsI.Range("B" & wsI.Rows.Count).End(xlUp).Row

    '~~> Open a new workbook
    Set wbO = Workbooks.Add
    '~~> Set this to the relevant worksheet
    Set wsO = wbO.Sheets(1)

    '~~> The first row in Col A for writing
    erow = 1
    '~~> Copy Header
    wsI.Range("B7:BG7").Copy wsO.Range("A" & erow)

    '~~> Increment output row by 1
    erow = erow + 1

    '~~> Copy all rows from 11 to last row
    wsI.Range("B11:BG" & LastRow).Copy wsO.Range("A" & erow)

    '~~> Clear Clipboard
    Application.CutCopyMode = False

    '
    '~~> Code here to do a Save As
    '
End Sub

Answer 2

不同但相同

重命名工作表

Sub Button1_Click()
    Dim wb As Workbook, ws As Worksheet, sh As Worksheet
    Dim LstRw As Long, Rng As Range, Hrng As Range

    Set sh = Sheets("MySheetName")

    With sh
        Set Hrng = .Range("B7:BG7")
        LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set Rng = .Range("B11:BG" & LstRw)
    End With

    Application.ScreenUpdating = 0

    Workbooks.Open Filename:="C:\Users\abcd\Documents\Newformat.xlsx"

    Set wb = Workbooks("Newformat.xlsx")
    Set ws = wb.Sheets(1)

    Hrng.Copy ws.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    Rng.Copy ws.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    ws.Name = sh.Name    'renames sheet
    wb.Save
    wb.Close

End Sub