|
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(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
|
|