如何为每个循环向下移动1行，直到单元格为空

Question

如何在每个循环中向下移动1行，直到A列中的单元格为空？

我需要从第5行开始复制到另一个工作簿然后循环到下一行（Row6），直到内容为空。

这是我的代码

    Sub Macro3()
'''
Do

''GRAB A ROW
    Windows("theFILE2.working.xlsm").Activate
    Rows("5:5").Select
    Selection.Copy
    Workbooks.Open "D:\folder1\folder2\Projects\The FILES\New folder\OVERVIEW TEMPLATE(macro edition)(current).xlsm"
    Windows("OVERVIEW TEMPLATE(macro edition)(current).xlsm").Activate
    Sheets("LISTS").Select
    Rows("4:4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Windows("OVERVIEW TEMPLATE(macro edition)(current).xlsm").Activate
    Sheets("PLANT OVERVIEW").Select

''SAVE AS
    Dim Path As String
    Dim FileName1 As String
    Dim FileName2 As String


    FileName1 = Range("N1").Value
    FileName2 = Range("A1").Value

    Path = "D:\folder1\folder2\Projects\The FILES\theFILES\" & FileName1 & "\"

    ActiveWorkbook.SaveAs Filename:=Path & FileName2 & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

    ActiveWorkbook.Close

Loop

End Sub

高级谢谢！

Answer 1

我认为你是VBA的新手，并且有一些概念你很快就会恢复。在Excel中录制宏是了解如何在Excel中执行某些操作的好方法。但是，Excel的方式也存在一些缺点。以下是一些有用的概念：

1. 不使用选择， ActiveCell ， ActiveSheet ，选择，激活等，除非你绝对必须这样做。我知道Excel中的宏录制器有什么用，但是如果你做得不对，它可能会导致错误，特别是当你开始使用多个工作簿时！

   更好地分配对象，并使用该对象执行您想要执行的操作。在下面的代码中，我将工作簿和工作表分配给对象，并使用它们来完成工作。 范围也是常用的对象。

2. 与此相关，请务必始终完全限定对象。例如，您可以编写如下代码：Var1 = Cells(1, 1).Value但它将从 Active Worksheet 中的单元格A1获取值，而不是您想要的工作表或工作簿。以这种方式编写它会更好：Var1 = wksSource.Cells(1, 1).Value我确实指定了一个工作表名称＆＃34; Sheet1＆＃34;对于您的源工作簿 - 将其更改为您从复制的工作表的实际名称。

3. 我将最常见的字符串分配给顶部的常量。在将每个字符串分配给常量并仅使用内联字符串之间存在平衡（例如，某些字符串可能将表单名称分配为＆＃34; LISTS＆＃34;为常量），但如果它们是＆＃39;只使用过一次，在显眼的地方，我不担心为它分配常数。但是，特别是当值被多次使用时，常量会使您更容易在需要重用代码执行类似任务时使用。我还为源路径添加了一个常量，但如果工作簿已经打开则不需要。

4. 我还在顶部声明了所有变量 - 有些语言和程序员做的不同，但我希望能够看到开头使用的是什么。

5. 注意 Do ... Loop 上的 While 说明符。这只会在当前行的第一列中有值时循环。

以下是我为您的任务编写代码的方法：

Sub Macro3()

    Dim SourceRow As Long
    Dim DestRow As Long
    Dim Path As String
    Dim FileName1 As String
    Dim FileName2 As String
    Dim FullFileName As String

    Dim wkbSource As Workbook
    Dim wksSource As Worksheet
    Dim wkbDest As Workbook
    Dim wksDest As Worksheet
    Dim wksDest2 As Worksheet

    Const scWkbSourcePath As String = "D:\folder1\folder2\Projects\"        ' For example
    Const scWkbSourceName As String = "theFILE2.working.xlsm"
    Const scWkbDest1Path As String = "D:\folder1\folder2\Projects\The_FILES\New_folder\"
    Const scWkbDest1Name As String = "OVERVIEW TEMPLATE_macro edition_current_.xlsm"
    Const scWkbDest2Path As String = "D:\folder1\folder2\Projects\The_FILES\theFILES\"

    Set wkbSource = Workbooks(scWkbSourceName)
    Set wksSource = wkbSource.Sheets("Sheet1")      ' Replace Sheet1 with the sheet name
    SourceRow = 5
    DestRow = 4

Do While wksSource.Cells(SourceRow, 1).Value <> ""
    ' Open the template workbook
    Set wkbDest = Workbooks.Open(scWkbSourcePath & scWkbDest1Name)
    Set wksDest = wkbDest.Sheets("LISTS")

''COPY A ROW
    wksSource.Rows(SourceRow).Copy Destination:=wksDest.Rows(DestRow)
    Application.CutCopyMode = False
    With wksDest.Rows(DestRow).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    wkbDest.Activate
    Set wksDest2 = wkbDest.Sheets("PLANT OVERVIEW")

''SAVE AS
    FileName1 = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
        Replace(wksDest2.Range("N1").Value _
        , ".", "_") _
        , "/", "_") _
        , "\", "_") _
        , "?", "_") _
        , "|", "_") _
        , "<", "_") _
        , ">", "_") _
        , ":", "_") _
        , "*", "_") _
        , """", "_")
    FileName2 = wksDest2.Range("A1").Value

    Path = scWkbDest2Path & FileName1 & "\"
    If Len(Dir(Path, vbDirectory)) = 0 Then
        MkDir Path
    End If
    FullFileName = Path & FileName2 & ".xlsx"
    wkbDest.SaveAs Filename:=FullFileName, FileFormat:=xlOpenXMLWorkbook
    wkbDest.Close

    ' Best practice to set objects to Nothing before re-using an object variable
    Set wksDest = Nothing
    Set wksDest2 = Nothing
    Set wkbDest = Nothing

    ' Move down 1 row for source sheet
    SourceRow = SourceRow + 1
Loop

End Sub

修改

我学到的关于文件夹和文件名字符的一些注意事项：

• 虽然在文件名中可以​​使用括号 ，但我无法保存原始文件名 - 但删除括号可以解决问题。
• 由于您要从（可能很脏的）数据创建文件和文件夹名称，因此您应该清理（删除或替换为 _ ）不能使用的字符这些名称： \ / | ？ ＆lt; ＆gt; < / strong> ： * ＆＃34;
• 我在Naming Files, Paths, and Namespaces的Microsoft页面上找到了这个：

  

请勿使用空格或句点结束文件或目录名称。

• 虽然允许在文件名中使用，但句号（。）不能是文件夹名称的最后一个字符，通常是在文本字符串中找到它的位置。此外，它可能会令人困惑，偶尔也会在文件名中引起问题，所以我建议全部替换它们。

  • Trim（）函数可用于删除文件夹名称末尾的空格。请注意，在字符串中，它还会将一行中的多个空格更改为单个空格。

• 特别是因为您要从数据创建文件夹，所以在将文件保存到文件夹之前，需要确保该文件夹存在。 MkDir 是此命令。

• 如果您的模板工作簿在启动时未打开，则可能需要在Open（）语句中指定路径。