Question

所以我有4张名为＆＃34; old＆＃34;，＆＃34; current＆＃34;，＆＃34; input＆＃34;和＆＃34;按钮＆＃34;。过程是：按下＆＃34;按钮上的按钮＆＃34;表格清除＆＃34;当前＆＃34;表格和＆＃34;输入＆＃34;表格，将数据粘贴到＆＃34;输入＆＃34;选择并按下＆＃34;按钮上的宏按钮＆＃34;表格填充＆＃34;当前＆＃34;片。大多数宏将格式化＆＃34;当前＆＃34;表格和使用索引匹配来自＆＃34; old＆＃34;片。我想要做的就是在开头添加一个步骤来清除＆＃34; old＆＃34;表格，然后复制并粘贴来自＆＃34;当前＆＃34;把纸张放到＆＃34; old＆＃34;片。原因是我将每周使用这个，每次运行宏时，我都想要＆＃34;当前＆＃34;工作表，这是我上次运行宏时创建的，移动到＆＃34; old＆＃34;片。这是我目前的代码......

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

谢谢你们。

Answer 1

像这样的小功能应该可以解决问题。

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

如何清除工作表并从另一个工作表粘贴数据

1 个答案: