Excel 查找最后一行，复制上面的数据并另存为CSV

我正在尝试使用VBA自动创建数据集并另存为CSV。我有一个充满公式的动态_数据表，当来自Sheetlist工作表的输入给定时填写。根据公式，它可以是50行或500行。我只想保存已经计算过的数据，现在其中有值。但我并没有得到最后一行的值，整个工作表也被保存了，在实际数据之后还有很多空白行或零值行。 请帮助更正脚本。 这是我使用的代码

Sub CompileBPData()

Dim s As String
Dim sname As String
Dim StartName As String
Dim EndName As String
Dim MidName As String
Dim StartNum As String
Dim EndNum As String
Dim CoverNum1 As String
Dim CoverNum2 As String
Dim Cover As String
Dim IntMax As String
Dim GetNewSuffix As String
Dim Job As String
Dim Book As String
Dim EA As String
Dim Lrow As Long
On Error Resume Next
GetNewSuffix = " ("
IntMax = ") "
StartName = "Book "
EndName = "Job_"
MidName = "-"

Sheets("Sheetlist").Select
' Open dialouge box for selecting header
Job = InputBox("Enter Job Number")
If Job = "" Then
  Exit Sub
  End If
s = InputBox("Enter Next Book Number")
If s = "" Then
  Exit Sub
End If
Range("D2").Value = s

Book = InputBox("How many Books in One Column")
If Book = "" Then
  Exit Sub
  End If
Range("H3").Value = Book
EA = InputBox("EA Code & Name Please")
If EA = "" Then
  Exit Sub
End If
Range("I8").Value = EA

'******Finding Last row with no value*********
With wsInpt.Columns("E").SpecialCells(Type:=xlCellTypeBlanks)
    Lrow = .Cells(.Cells.Count).Row
End With
'Lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'**********Select Data Sheet and create Paper Data *********

Sheets("Sheetlist").Select
Range("E2").Select
StartNum = Range("E2")
EndNum = Range("E7")
CoverNum1 = Range("D2")
CoverNum2 = Range("E9")
Cover = Range("I2")
Sheets("Dynamic_Data").Select
ActiveWorkbook.SaveAs Filename:=EA & MidName & StartName & CoverNum1 & MidName & CoverNum2 & GetNewSuffix & "G" & StartNum & MidName & "G" & EndNum & IntMax & Cover & " " & StartName & "_" & EndName & Job, FileFormat:=xlCSV, CreateBackup:=False
ActiveSheet.Name = "Dynamic_Data"
Sheets("Sheetlist").Select
Range("D2").Select
    
End Sub

---

希望这能对你有所帮助

Sub CompileBPData()
Dim s As String
Dim sname As String
Dim StartName As String
Dim EndName As String
Dim MidName As String
Dim StartNum As String
Dim EndNum As String
Dim CoverNum1 As String
Dim CoverNum2 As String
Dim Cover As String
Dim IntMax As String
Dim GetNewSuffix As String
Dim Job As String
Dim Book As String
Dim EA As String
Dim Lrow As Long
On Error Resume Next
GetNewSuffix = " ("
IntMax = ") "
StartName = "Book "
EndName = "Job_"
MidName = "-"

Sheets("Sheetlist").Select
' Open dialouge box for selecting header
Job = InputBox("Enter Job Number")
If Job = "" Then
  Exit Sub
  End If
s = InputBox("Enter Next Book Number")
If s = "" Then
  Exit Sub
End If
Range("D2").Value = s

Book = InputBox("How many Books in One Column")
If Book = "" Then
  Exit Sub
  End If
Range("H3").Value = Book
EA = InputBox("EA Code & Name Please")
If EA = "" Then
  Exit Sub
End If
Range("I8").Value = EA

'******Finding Last row with no value*********
With wsInpt.Columns("E").SpecialCells(Type:=xlCellTypeBlanks)
    Lrow = .Cells(.Cells.Count).Row
End With
'Lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'**********Select Data Sheet and create Paper Data *********

Sheets("Sheetlist").Select
Range("E2").Select
StartNum = Range("E2")
EndNum = Range("E7")
CoverNum1 = Range("D2")
CoverNum2 = Range("E9")
Cover = Range("I2")

'------------------ BEGIN OF EDITED PART --------------------------------
'Loop Until Calculation is Done
Do
    DoEvents
Loop While Not Application.CalculationState = xlDone

'Find Last ROW
Dim LastRow As Double

  LastRow = 60001 ' <-- NOTE!: YOU MUST PUT HERE MAX ROWS NUMBER ))
Do
  LastRow = LastRow - 1
Loop Until Worksheets("Dynamic_Data").Range("A" & LastRow).Value <> 0

MsgBox "LastRow= " & LastRow

'Copy the Range of Data
  Worksheets("Dynamic_Data").Range("A1:AB" & LastRow).Copy

'Save the CSV File
Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT
    Set tempWB = Application.Workbooks.Add(1)
    With tempWB
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        .SaveAs Filename:=EA & MidName & StartName & CoverNum1 & MidName & CoverNum2 & GetNewSuffix & "G" & StartNum & MidName & "G" & EndNum & IntMax & Cover & " " & StartName & "_" & EndName & Job, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With
Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS
'------------------ END OF EDITED PART --------------------------------

ActiveSheet.Name = "Dynamic_Data"
Sheets("Sheetlist").Select
Range("D2").Select
End Sub

子编译BPDATA（）
像线一样变暗
像绳子一样模糊
Dim StartName作为字符串
Dim EndName作为字符串
将中间名设置为字符串
暗星作为弦
作为字符串的Dim EndNum
作为字符串的Dim CoverNum1
作为字符串的Dim CoverNum2
暗盖如弦
作为字符串的Dim IntMax
Dim GetNewSuffix作为字符串
将作业设置为字符串
把书当作线
将EA变暗为字符串
暗淡的光线和长的一样
出错时继续下一步
GetNewSuffix=“（”
IntMax=“）”
StartName=“书本”
EndName=“作业”
MidName=“-”
图纸（“图纸列表”）。选择
'打开拨号框以选择标题
作业=输入框（“输入作业编号”）
如果Job=”“，则
出口接头
如果结束
s=输入框（“输入下一个书号”）
如果s=”“，则
出口接头
如果结束
范围（“D2”）。值=s
Book=InputBox（“一列中有多少本书”）
如果Book=”“，则
出口接头
如果结束
范围（“H3”）。价值=账面价值
EA=输入框（“请输入EA代码和名称”）
如果EA=”“，则
出口接头
如果结束
范围（“I8”）。值=EA
“******正在查找没有值的最后一行*********
带有wsInpt.Columns（“E”）.SpecialCells（类型：=xlCellTypeBlanks）
Lrow=.Cells（.Cells.Count）.Row
以
'Lrow=ActiveSheet.Cells（Rows.Count，1）.End（xlUp）.Row
'**********选择数据表并创建图纸数据*********
图纸（“图纸列表”）。选择
范围（“E2”）。选择
StartNum=范围（“E2”）
EndNum=范围（“E7”）
CoverNum1=范围（“D2”）
CoverNum2=范围（“E9”）
覆盖范围=范围（“I2”）
'--------------编辑零件的开头--------------------------------
'循环，直到计算完成
做
多芬特
非应用程序时循环。计算状态=xlDone
“找到最后一行
将最后一行变暗为双行
LastRow=60001'能否附上您正在处理的数据文件样本？文件很重。请找到下载链接。下面建议的解决方案是什么。这真的很有帮助。这解决了大部分问题。我还有一个请求。如果我将“一列中的图书数量”更改为“最后一个图书数量”，它将填充数据直到最后一个数字。可能所有列的填充都不均匀。如何检查？