Question

我正在尝试编写VBA代码以将“非空白”单元从一个文件复制到另一个文件。这段代码选择了最后一个非空白行，但是该列正在复制A4 to AU。我想复制A4 to LastcolumnNotblank列以及最后一行。所以基本上复制A4 to (LastColumn)(LastRow)Not Blank

如果有人可以通过编辑以下代码来提供帮助，将非常感谢。非常感谢。

Sub Export_Template()

'' TPD

File_name = Application.GetSaveAsFilename(InitialFileName:="Engineering TPD", FileFilter:="Excel Files (*.xlsx), *.xlsx")

If File_name <> False Then

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False

 LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

 For i = 4 To LastRow
 If Left(ActiveSheet.Range("A" & i).Value, 1) <> "" Then lastactiverow = i
 Next i
   'MsgBox (lastactiverow)
    ActiveSheet.Range("A4:AU" & lastactiverow).Select
    Selection.Copy

Set NewBook = Workbooks.Add

ActiveSheet.Range("A1").PasteSpecial xlPasteValues

    ActiveWorkbook.SaveAs Filename:=File_name, FileFormat:=51

    ActiveWorkbook.Close (False)

End If
End Sub

Answer 1

我假设var hasFocus = true; $(window).focus(function(){ hasFocus = true; }); $(window).blur(function(){ hasFocus = false; }); //check the hasFocus variable to see if the window has focus是最后一次使用行的好指示
还假设Col A是最后一次使用列在哪里的好指标
您需要将代码第三行上的Row 1更改为包含要复制数据的工作表的名称
您需要声明变量（使用Sheet1）
不惜一切代价避免使用Option Explicit和.Select（在下面的解决方案中找不到）
您没有重新启用.Selection和ScreenUpdating
这已通过测试并且可以确定

DisplayAlerts

Answer 2

下面的代码将保留您的ActiveSheet范围，并使用SaveAs使用您的特定名称保存到新工作簿中，而不会产生任何多余的废话。它将删除除ActivSheet之外的所有工作表，并删除前三行，然后使用SaveAs保存到ThisWorkbook.Path。您启用宏的工作簿将不会更改。由于明显的问题，我实际上不喜欢使用ActiveSheet，但是由于您一直在使用它，所以我保留了它。我建议您使用工作表的名称。

Sub SaveActiveSheetRangeAsNewWorkbook()
Dim ws As Worksheet

Application.DisplayAlerts = False

    With ThisWorkbook
        For Each ws In Application.ThisWorkbook.Worksheets
            If ws.Name <> ActiveSheet.Name Then
                ws.Delete
            End If
        Next

        .Sheets(1).Range("A1:A3").EntireRow.Delete
        .SaveAs Filename:="Engineering TPD", FileFormat:=xlOpenXMLWorkbook
    End With

Application.DisplayAlerts = True

End Sub

VBA代码将非空白单元格从一张纸复制到另一张纸

2 个答案: