나눔터  
  HOME > 나눔터 > 묻고답하기 > 엑셀
엑셀
엑셀에 대한 질문과 답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
 "000 님, 도와주세요", "부탁 드립니다.", "급합니다!" 등과 같이 막연한 제목을 달지 말아주세요.
[필독] 빠르고 정확한 답변을 얻는 16가지 Tip !
[필독] 저작권법 개정에 따른 이용안내
작성자:  

 dew (dewdrop)

추천:  2
파일:     vba 설정(3)_Ans.xlsm (49.8KB) 조회:  2043
제목:   [RE][VBA] 특정 값이 있는 행 다른 시트로 붙여넣기
     
  * 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.

 - 엑셀 버전(95,97,2000,xp,2003,2007):

* 아래줄에 질문을 작성하세요 >>

* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.

 - 엑셀 버전(95,97,2000,xp,2003,2007):

* 아래줄에 질문을 작성하세요 >>


1. sheet1처럼 데이터가 구분(order DB/acc DB)되어 입력이 됩니다. 이렇게 입력된 데이터에서 A열에 "입력"이라고 표시된 행만 복사되어야합니다.

2. 이렇게 입력이라고 표시된 행은 구분된 이름과 동일한 sheet에 붙여넣어져야 합니다.

3. sheet1의 데이터는 계속 변동이 되고 이 변동된 데이터들은 각 sheet에 아래로 누적이 되어야 합니다.

4. 참고로 sheet1의 값들은 수식으로 지정되어 있어서 각 sheet로 붙여넣을 때 값만 복사가 되어 입력이 되어야 합니다.


위의 조건을 만족하는 매크로 답변 부탁 드리겠습니다.
==============[김영희님 글에 대한 답변입니다]==============

첨부화일 참고하세요...

Sub UpdateDB()
    Dim wst As Worksheet, wstX As Worksheet
    Dim rOrder As Range, rAcc As Range
    Dim rCell As Range, rTg As Range
    Dim iX As Integer
    
    Call SpeedOn(True)
    
    Set wst = Worksheets("Sheet1")
    
    Set rOrder = wst.Range("B3")
    Set rAcc = wst.Range("B21")
    
    For iX = 1 To 2
        Set rCell = wst.Cells(Choose(iX, rOrder.Row, rAcc.Row) + 3, 1)
        Set wstX = Choose(iX, Worksheets("order DB"), Worksheets("acc DB"))
        
        Do While rCell <> ""
            If rCell = "입력" Then Call WriteDb(wstX, rCell.Offset(0, 1).Resize(1, 61))
            
            Set rCell = rCell.Offset(1)
        Loop
    Next
    
    Application.Goto rOrder
    Call SpeedOn(False)
End Sub

Sub WriteDb(wstX As Worksheet, rRecord As Range)
    Dim rTg As Range
    
    Set rTg = wstX.Cells(Rows.Count, 2).End(3)(2)
    
    rRecord.Copy
    rTg.PasteSpecial xlPasteValues
    rTg.PasteSpecial xlPasteFormats
    'rTg.PasteSpecial xlPasteColumnWidths
    Application.CutCopyMode = False
    Application.Goto rTg, False
End Sub

Sub SpeedOn(Optional bX As Boolean = True)
    With Application
        .ScreenUpdating = Not bX
        .EnableEvents = Not bX
        .Calculation = IIf(bX, xlCalculationManual, xlCalculationAutomatic)
    End With
End Sub
 
[불량 게시물 신고]  
        
  

작성일 : 2019-10-14(10:30)
최종수정일 : 2019-10-14(10:30)
 


 ◎ 관련글

  제 목   작성자   날짜
[VBA] 특정 값이 있는 행 다른 시트로 붙여넣기 김영희 2019-10-10
[RE][VBA] 특정 값이 있는 행 다른 시트로 붙여넣기 dew 2019-10-14
[RE][VBA] 특정 값이 있는 행 다른 시트로 붙여넣기 파도타기 2019-10-11