如何解决如果单元格具有特定值,如何复制行并将其粘贴到新创建的Excel文件中
我是Excel VBA的新手,我确实需要以下问题的帮助:
我需要Excel创建新工作簿并根据A列值命名它们。因此,在这种情况下,我需要使用以下数据才能擅长创建17个新工作簿:
应根据A列中给出的值来命名每个工作簿,在这种情况下,新工作簿应命名为1,2,3 ... 16,18(请注意,如果不包含数字17可能),并且如果A列中的某行具有某个特定值(在这种情况下,数字为1到18,但17除外),则每个新工作簿都应复制该主表的行。另外,它还需要复制主表的标题。因此,新创建的工作簿应如下所示:
以此类推。
我尝试使用以下无效的代码将所需的值复制到其他工作表中:
Sub asd()
Dim i As Integer
Dim y As Integer
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
y = 18
i = 1
For i = 1 To y
Sheets("Master").Range("A1:C1").Copy Sheets(i).Range("A1:C1")
A = Worksheets("Master").UsedRange.Rows.Count
B = Worksheets(i).UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets(i).UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Master").Range("A1:A" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = i Then
xRg(C).EntireRow.Copy Destination:=Worksheets(i).Range("A" & B + 1)
B = B + 1
End If
Next
Next
Application.ScreenUpdating = True
End Sub
我可以使用以下代码基于列A上的单元格值创建新的工作表:
Sub AddSheetsFromCells()
Dim xRgx As Range,wBkx As Workbook
Set wBkx = ActiveWorkbook
On Error GoTo Quit
Set dbRange = Application.InputBox("Range: ","Select Range",_
Application.Selection.Address,Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xRgx In dbRange
With wBkx
.Sheets.Add After:=.Sheets(.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xRgx.Value
If Err.Number = 1004 Then
Debug.Print Chr(34) & xRgx.Value & Chr(34) & " already used as a sheet name"
.ActiveSheet.Delete
End If
On Error GoTo 0
End With
Next xRgx
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Quit:
End Sub
但是我不能将两者结合在一起或创建新的工作簿。我完全被困住了。
非常感谢您的帮助。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。