我在下面录制了宏，用于在运行宏时将我输入一个工作表的数据自动传输到另一个工作表。目前，我必须为此工作簿中的每个新工作表记录一个宏，并根据我需要将新数据传输到哪个工作表运行每个单独的宏。我想知道如何根据原始工作表的G列中的文本，为此宏添加条件，该宏将自动决定将新数据发送到哪个工作表。 G列中可能包含四种不同的文字短语。非常感谢任何帮助！
Sub over_90_days()
'
' over_90_days Macro
' transfer info from all terms to over 90 days sheet
'
'
ActiveCell.Offset(0, -7).Columns("A:A").EntireColumn.Select
Selection.End(xlDown).Select
End Sub
Sub update()
'
' update Macro
' move new data to a different worksheet
'
'
Range("Table1[[#Headers],[Name, Last]]").Select
Selection.End(xlDown).Select
Range("A74:B74").Select
Selection.Copy
Sheets("90 DAYS OR LESS").Select
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("ALL TERMS").Select
ActiveCell.Offset(0, 2).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("90 DAYS OR LESS").Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste
Sheets("ALL TERMS").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("90 DAYS OR LESS").Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
Sheets("ALL TERMS").Select
ActiveCell.Offset(0, 2).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("90 DAYS OR LESS").Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=3
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
所以这是我的第二次光荣尝试：
Sub update()
Set MainSheet = ThisWorkbook.Worksheets("ALL TERMS")
Set Sheet1 = ThisWorkbook.Worksheets("TERM PRE OJT")
Set Sheet2 = ThisWorkbook.Worksheets("TERM POST OJT")
Set Sheet3 = ThisWorkbook.Worksheets("90 DAYS OR LESS")
Set Sheet4 = ThisWorkbook.Worksheets("OVER 90 DAYS")
Dim Rnge2 As Range
Set Rnge2 = "A2"
Dim i As Integer
For i = 1 To 50
MyValue = MainSheet.Cells(i, 7).Value
If MyValue = "orientation only" Then
ActiveCell.Offset(0, -6).Select
Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy
Sheet1.Select
Rnge2.Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select 'move down one row
ElseIf MyValue = "ojt only" Then
ActiveCell.Offset(0, -6).Select
Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy
Sheet2.Select
Rnge2.Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ElseIf MyValue = "90 days or less" Then
ActiveCell.Offset(0, -6).Select
Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy
Sheet3.Select
Rnge2.Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ElseIf MyValue = "over 90 days" Then
ActiveCell.Offset(0, -6).Select
Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy
Sheet1.Select
Rnge2.Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
End Sub
它不起作用，我不明白为什么。
答案 0 :(得分：1)
您可以选择以下表格：
dim MyWorksheet as Worksheet
set MyWorksheet = ThisWorkbook.Worksheets("the name of the sheet you want")
因此，您可以使用该工作表的名称将MyWorksheet设置为代码中的任何工作表：
dim MyWorksheet1 as Worksheet
set MyWorksheet1 = ThisWorkbook.Worksheets("the name a sheet")
dim MyWorksheet2 as Worksheet
set MyWorksheet2 = ThisWorkbook.Worksheets("the name of second sheet")
现在，您可以获取表格中的任何单元格：
dim MyCell as Range, MyCell2 as Range, MyCell3 as Range
set MyCell = MyWorksheet1.Range("G1") // gets G1
set MyCell2 = MyWorksheet1.Range("G:G") // gets the entire G column
set MyCell3 = MyWorksheet1.Cells(2,2) // gets B2
您可以通过以下方式查看单元格中的值：
MyCell.Value
您可以设置单元格的值：
MyCell.Value = "The Value I want" //a text
MyCell.Value = 2 //a number
MyCell.Value = MyCell2.Value //the value of another cell
有了这个，你可以玩并创建自己的代码，选择你想要的单元格并转移到你想要的纸张。
如果您不习惯编程，请在loops，if statements，select case statements上搜索VBA的教程。
录制的宏中出现的所有selection都可以替换为Range，就像上面显示的那样，除非你真的想要获得所选的单元格，然后使用选择作为记录。< / p>
copy和paste commands也适用于工作表，如上所示。但有时通过代码使用Range.Value传输值会更好（这可以避免复制格式和论坛，并且更快）。
一个例子：
MainSheet中的G列包含3行，我将根据单元格中的值将它们复制到Sheet1或Sheet2：
dim MainSheet as Worksheet, Sheet1 as Worksheet, Sheet2 as Worksheet
set MainSheet = ThisWorkbook.Worksheets("MainSheet")
set Sheet1 = ThisWorkbook.Worksheets("The name of sheet1")
set Sheet2 = ThisWorkbook.Worksheets("The name of sheet2")
dim i as integer
for i = 1 to 3 'this is a loop that will run three times with i from 1 to 3
dim MyValue as variant
MyValue = MainSheet.Cells(i,7).Value 'i is the row / 7 is G
'check the value of a cell in row "i" and column G
if MyValue = "the value I want to go to sheet 1" then
Sheet1.Cells(i,7).Value = MyValue 'copy to sheet 1 same row and column, but you can change that
else 'if value is not that one I expected
Sheet2.Cells(i,7).Value = MyValue 'copy to sheet 2....
end if 'this ends the if part of the code
next 'this ends the loop part of the code
看着你的第二次尝试：
在您的情况下，我认为Set Rnge2 = "A2"是第一个问题。 Range是您必须从工作表中检索的对象：Set Rnge2 = MainSheet.Range("A2")
在代码中，我总是避免使用接口的方法，比如复制/粘贴和活动单元格，这些方法很慢并且会引起更多关注。
所以我建议您执行以下操作：
'this forces me to declare all vars. It's a personal preference
'this way I don't have any var with an unidentified type
Option Explicit
Sub update()
'declare every sheet because I used option explicit
'option explicit obliges that we declare everything, I prefer it this way to avoid having unknown vars in the code
Dim MainSheet As Worksheet, Sheet1 As Worksheet, Sheet2 As Worksheet, Sheet3 As Worksheet, Sheet4 As Worksheet
Set MainSheet = ThisWorkbook.Worksheets("ALL TERMS")
Set Sheet1 = ThisWorkbook.Worksheets("TERM PRE OJT")
Set Sheet2 = ThisWorkbook.Worksheets("TERM POST OJT")
Set Sheet3 = ThisWorkbook.Worksheets("90 DAYS OR LESS")
Set Sheet4 = ThisWorkbook.Worksheets("OVER 90 DAYS")
Dim i As Integer
Dim R1 As Integer, R2 As Integer, R3 As Integer, R4 As Integer
Dim CurrentCell As Range
Dim MyValue As String
'keeping one row per sheet in order to move down separately
R1 = 2 'start row in sheet1
R2 = 2 'start row in sheet2
R3 = 2 'start row in sheet3
R4 = 2 'start row in sheet4
For i = 1 To 26
'Using a current cell in MainSheet, this will move down at the end of this loop
Set CurrentCell = MainSheet.Cells(i, 7)
'Taking value from the current cell
MyValue = LCase(CurrentCell.Value)
If MyValue = "orientation only" Then
'Created a sub that avoids repeating all the code four times
'copies the row i from main sheet to row R1 in Sheet1
Call CopyTo(MainSheet, i, Sheet1, R1)
R1 = R1 + 1 'move down one row'
ElseIf MyValue = "ojt only" Then
Call CopyTo(MainSheet, i, Sheet2, R2)
R2 = R2 + 1 'move down one row'
ElseIf MyValue = "90 days or less" Then
Call CopyTo(MainSheet, i, Sheet3, R3)
R3 = R3 + 1 'move down one row'
ElseIf MyValue = "over 90 days" Then
Call CopyTo(MainSheet, i, Sheet4, R4)
R4 = R4 + 1 'move down one row'
Else
MsgBox "Cell G" & Trim(Str(i)) & " has an invalid value"
End If
'move down the current cell in main sheet
Set CurrentCell = CurrentCell.Offset(1, 0)
Next
End Sub
Sub CopyTo(MainSheet As Worksheet, MainRow As Integer, TargetSheet As Worksheet, TargetRow As Integer)
Dim LineValue As Variant
'take all values from cell "Ai" to "Ei" in MainSheet
LineValue = MainSheet.Range(MainSheet.Cells(MainRow, 1), MainSheet.Cells(MainRow, 5)).Value
'puts this value in a same size range in target sheet
TargetSheet.Range(TargetSheet.Cells(TargetRow, 1), TargetSheet.Cells(TargetRow, 5)).Value = LineValue
End Sub