如何在vba excel中初始化我的柜台

我的vba项目有问题。 我的工作手册有4张（草稿，cky，co and和bey），在表格草稿中有我所有的数据，我想重新组织它们，表格“草稿”的列“G”包含值（cky，coy我希望我的macros通过colums并复制所有具有相同值的单元格，并将它们粘贴到单元格（A2）开始的对应表单中，例如：我希望macros复制所有数据有“cky”，并将其粘贴在表单“cky”中，从单元格A2开始，依此类推/下面你可以看到我迄今为止做了什么：

Sub MainPower() Dim lmid As String Dim srange, SelData, ExtBbFor As String Dim lastrow As Long Dim i, j, k As Integer lastrow = ActiveSheet.Range("B30000").End(xlUp).Row srange = "G1:G" & lastrow SelData = "A1:G" & lastrow For i = 1 To lastrow If InStr(1, LCase(Range("E" & i)), "bb") <> 0 Then Range("G" & i).Value = Mid(Range("E" & i), 4, 3) ElseIf Left(Range("E" & i), 1) = "H" Then Range("G" & i).Value = Mid(Range("E" & i), 7, 3) Else Range("G" & i).Value = Mid(Range("E" & i), 1, 3) End If Next i 'Sorting data Range("A1").AutoFilter Range(SelData).Sort key1:=Range(srange), order1:=xlAscending, Header:=xlYes 'Spreading to the appropriate sheets j = 1 For i = 1 To lastrow If Range("G" & i).Value = "CKY" Then Sheets("CKY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value ElseIf Range("G" & i).Value = "BEY" Then Sheets("BEY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value ElseIf Range("G" & i).Value = "COY" Then Sheets("COY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value End If j = j + 1 Next i End Sub 

谢谢你的帮助

Answer 1

在For循环中使用这个重构的代码，它应该为你更好地工作：

 For i = 1 To lastrow Select Case Sheets("Draft").Range("G" & i).Value Case is = "CKY","COY","BEY" Dim wsPaste as Worksheet Set wsPaste = Sheets(Range("G"& i).Value) Dim lRowPaste as Long lRowPaste = wsPaste.Range("A" & .Rows.COunt).End(xlup).Offset(1).Row wsPaste.Range("A" & lRowPaste & ":E" & lRowPaste).Value = _ Sheets("Draft").Range("C" & i & ":G" & i).Value End Select Next i