所以我有一些數據,我需要每月運行我的宏。我的代碼適用於我所需要的內容,但我認爲這對我來說可能是一個很好的機會嘗試和學習如何循環一些重複性很強的東西,因爲我對這些仍然很陌生。所以下面是我的代碼,基本上它只是複製列A和另一個指定列中的所有內容,將它們粘貼到一個新工作表中,重命名Sheet1上某個單元格後的工作表,並刪除包含空白單元格的所有空行。我只是簡單地複製並粘貼原始錄製的宏,並做了一些更改,使其完成整個工作表。需要幫助縮短我的VBA代碼,並使其循環
我會試着學習如何將它縮小和循環,而不是複製和粘貼它。這對我來說更像是一個學習的東西,因爲這個宏已經適用於我所需要的東西。
非常感謝!
Sub test()
'
' test Macro
'
'
Application.ScreenUpdating = False
Range("A:A,B:B").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("B1").Value
Sheets("Sheet1").Activate
Range("A:A,C:C").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("C1").Value
Sheets("Sheet1").Activate
Range("A:A,D:D").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("D1").Value
Sheets("Sheet1").Activate
Range("A:A,E:E").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("E1").Value
Sheets("Sheet1").Activate
Range("A:A,F:F").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("F1").Value
Sheets("Sheet1").Activate
Range("A:A,G:G").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("G1").Value
Sheets("Sheet1").Activate
Range("A:A,H:H").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("H1").Value
Sheets("Sheet1").Activate
Range("A:A,I:I").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("I1").Value
Sheets("Sheet1").Activate
Range("A:A,J:J").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("J1").Value
Sheets("Sheet1").Activate
Range("A:A,K:K").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("K1").Value
Sheets("Sheet1").Activate
Range("A:A,L:L").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("L1").Value
Sheets("Sheet1").Activate
Range("A:A,M:M").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("M1").Value
Sheets("Sheet1").Activate
Range("A:A,N:N").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
ActiveSheet.Name = Sheet1.Range("N1").Value
Sheets("Sheet1").Activate
End Sub
你嘗試過什麼圈? (同時,同時)? – chancea 2014-12-05 17:20:56