2016-07-18 2 views
0

내 vba 프로젝트에 문제가 있습니다. 내 통합 문서는 "초안에 모든 데이터가 있는데 다시 구성하려고합니다." "초안"열의 "G"열에 값 (cky, coy 및 bey)이 포함되어 있습니다. coy 및 bey). 매크로를 통과하여 같은 값을 가진 모든 셀을 복사하여 셀 (A2)에서 시작하는 해당 시트에 붙여 넣기를 원합니다. 예를 들어 매크로를 모두 복사하려면 "CKY"를 가지고 셀 A2에서 그래서 당신 아래/ 부터 시트 "CKY"에 붙여 데이터는 지금까지 무엇을했는지 볼 수 있습니다 vba에서 내 카운터를 초기화하는 방법

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 

이 최선의 도움을 주셔서 감사합니다 안부

+0

무엇이 문제입니까? – arcadeprecinct

+0

당신이 한 모든 일은 우리에게 당신이하고있는 일에 대해 말해 주지만 작동하지 않는 것에 대해서는 아무 것도 말하지 않았고 무슨 일이 일어나고 있는지에 대해서는 말하지 않았습니다 –

+0

매번 j를 증가시킬 때'sheets ("CKY") .range ("A1"). end (xlDown) .row' 각 시트의 행을 j로 사용하므로 한 번에 한 시트 씩만 사용할 때 행을 증가시킵니다. –

답변

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 
+1

내가 원하는 방식으로 작업 해 주셔서 감사합니다. –

관련 문제