如何清除工作表并将数据粘贴到其他工作表上
所以我有4张被称为“旧”，“当前”，“input”和“button”的表。 这个过程是：按下“button”表上的button以清除“当前”表格和“input”表格，将数据粘贴到“input”表格上，并按下“button”表格上的macrosbutton来填充“当前“表格。 大部分macros将格式化“当前”表格，并使用索引匹配“旧”表格中的数据。 我想要做的是在开始添加一个步骤清除“旧”表，然后将数据从“当前”表复制并粘贴到“旧”表。 原因是我每周都会用这个macros，每次运行这个macros时，我都需要上次运行macros时创build的“当前”表，移动到“旧”表。 这是目前我有的代码…
Sub Load16() Application.ScreenUpdating = False 'Define Workbooks Dim loopCount As Integer Dim loopEnd As Integer Dim writeCol As Integer Dim matchRow As Integer Dim writeRow As Integer Dim writeEnd As Integer loopEnd = WorksheetFunction.CountA(Worksheets("Input").Range("A:A")) writeEnd = WorksheetFunction.CountIf(Worksheets("Input").Range("L:L"), "-1") loopCount = 1 writeRow = 1 Worksheets("Buttons").Range("F17:I17").Copy Worksheets("Current").Range("J2:M" & writeEnd).PasteSpecial Paste:=xlPasteAll Application.CutCopyMode = False Do While loopCount <= loopEnd If Worksheets("Input").Cells(loopCount, 12).Value <> "" And Worksheets("Input").Cells(loopCount, 12).Value <> 0 Then Worksheets("Current").Cells(writeRow, 1).Value = Worksheets("Input").Cells(loopCount, 26).Value writeCol = 2 Do While writeCol <= 9 Worksheets("Current").Cells(writeRow, writeCol).Value = Worksheets("Input").Cells(loopCount, writeCol - 1) writeCol = writeCol + 1 Loop writeCol = 14 Do While writeCol <= 30 Worksheets("Current").Cells(writeRow, writeCol).Value = Worksheets("Input").Cells(loopCount, writeCol - 5) writeCol = writeCol + 1 Loop Worksheets("Current").Cells(writeRow, 31).Value = Worksheets("Input").Cells(loopCount, 27) writeRow = writeRow + 1 Else End If loopCount = loopCount + 1 Loop Worksheets("Current").Range("J1").Value = "Counsel" Worksheets("Current").Range("K1").Value = "Background" Worksheets("Current").Range("L1").Value = "Comments" Worksheets("Current").Range("M1").Value = "BM Action" Lookup Data for K - M and a few other things loopCount = 2 Do While loopCount <= loopEnd matchRow = 0 On Error Resume Next matchRow = WorksheetFunction.Match(Worksheets("Current").Cells(loopCount, 1).Value, _ Worksheets("Old").Range("A:A"), 0) If matchRow = 0 Then Else Worksheets("Current").Cells(loopCount, 11).Value = Worksheets("Old").Cells(matchRow, 11).Value Worksheets("Current").Cells(loopCount, 12).Value = Worksheets("Old").Cells(matchRow, 12).Value Worksheets("Current").Cells(loopCount, 13).Value = Worksheets("Old").Cells(matchRow, 13).Value End If Worksheets("Current").Cells(loopCount, 10).Value = Worksheets("Current").Cells(loopCount, 18).Value loopCount = loopCount + 1 Loop Sheets("Current").Range("A2:AE" & loopEnd).Sort Key1:=Sheets("Current").Range("H2"), _ Order1:=xlAscending, Header:=xlNo Worksheets("Current").Columns("A:BZ").AutoFit Application.ScreenUpdating = True Worksheets("Buttons").Select MsgBox loopEnd - 1 & " Rows processed. " & writeEnd & " Rows remain." End Sub 多谢你们。
像这样的一个小函数应该做的伎俩。
Sub copy_current_data() 'Select Old Sheet Sheets("Old").Select 'Clear all cells from Old Sheet Sheets("Old").Cells.ClearContents 'Copy Cells from Current Sheet Sheets("Current").Cells.Copy 'Select "A1" in old sheet Sheets("Old").Range("A1").Select 'Paste Data ActiveSheet.Paste End Sub