행에 셀을 복사하고 모든 n 번째 셀을 붙여 넣습니다.

Question

필자는이 두 가지 파일을 비교해야합니다. 여기 상황이 있습니다.

새 데이터가있는 소스 파일이 있습니다. 이 경우 데이터는 Row 59에 있고 값 (숫자)은 C59에서 시작하여 CB59까지 수평으로 이동합니다. 일부 값은 특별하고 굵게 표시되어 있습니다. 그러면 다른 파일 (대상)이 있습니다. 데이터는 열 D에서 D9에서 시작하여 D675로 이동하지만 값은 매 9 셀입니다. (D19, D18, D27 등). 그들은 완벽하게 일치합니다.

소스 파일의 값을 찾고 굵은 글꼴로만 값을 붙여 넣기위한 매크로가 필요합니다. 예를 들어, 원본 파일의 C59, D59, E59, F59에 값이있는 경우 대상 파일의 해당 파일은 각각 D9, D18, D27, D36이됩니다. 그러나 D59 및 E59 만 굵게 표시된 값은 대상 파일에 복사 된 유일한 값입니다.이 경우 D18 및 D27의 값만 변경됩니다. 또한 복사 할 경우 굵게 표시하지 말고 일반 문자로 입력해야합니다.

도움 주셔서 감사합니다.

업데이트 : 대담한 데이터는 삭제하시기 바랍니다. 방금 복사 한 모든 데이터를 찾고 있습니다. 나는 WbBook2의 CB 열에서 I 열에서 58 행의 값을 적절하게 붙여 넣기하고 D36 및 모든 9 번째 셀에서 시작하여 wbBook1에 붙여 넣기를 지원해 달라.

나는이 코드를 시도하고 wbBook 1 D36, D45 및 D54에 동일한 wbBook2 I58 값을 붙여 넣습니다. 그런 다음 나머지 셀은 매 9 일마다 비어 있고 갑자기 D243에서 멈 춥니 다.

CODE

Sub Macroloco_() 

Dim wbBook1 As Workbook 

Dim wbBook2 As Workbook 

Set wbBook1 = ThisWorkbook 
Set wbBook2 = Workbooks.Open("C:\reports Sep\week38.xls") 

Dim wsSheet1 As Worksheet 
Dim wsSheet2 As Worksheet 
Set wsSheet1 = wbBook1.Worksheets("01") 
Set wsSheet2 = wbBook2.Worksheets("results") 

Dim lastColumn As Long 
Dim targetRow As Long 
Dim i As Long 

targetRow = 36 

lastColumn = wsSheet2.Range("CB" & Columns.Count).End(xlUp).Column 
For i = 58 To lastColumn 
wsSheet2.Range("I" & i).Copy 
wsSheet1.Range("D" & targetRow).PasteSpecial xlPasteAll 

targetRow = targetRow + 9 

Next i 

End Sub 

Answer 1

추가 당신은 LastColumn가 마지막 행을 찾고 있습니다.

lastColumn = wsSheet2.Range("CB" & Columns.Count).End(xlUp).Column 

이어야한다

With wsSheet2 
    lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column 
End With 

---

편집 :

내 테스트 코드 :

Sub fdsa() 

    Dim i As Long, j As Long, k As Long 
    With Sheets("Sheet1") 
     j = .Cells(1, .Columns.Count).End(xlToLeft).Column 
     k = 1 
     For i = 1 To j 
      .Cells(i, 1).Copy 
      Sheets("Sheet2").Cells(k, 4).PasteSpecial xlPasteAll 
      k = k + 1 
     Next i 
    End With 
End Sub 

Edit2가 :

나는 읽을 때 오해했다. 행을 반복하고 행을 붙여 넣었습니다. 번역과 마찬가지로 원을 반복하고 행을 붙여 넣기를 원합니다.

Sub fdsa() 
    Dim i As Long, j As Long, k As Long 
    With Sheets("Sheet1") 
     j = .Cells(1, .Columns.Count).End(xlToLeft).Column 
     k = 1 
     For i = 1 To j 
      .Cells(1, i).Copy 'changed to copy the iterating COLUMN 
      Sheets("Sheet2").Cells(k, 4).PasteSpecial xlPasteAll 'Still pastes in every 9th ROW 
      k = k + 1 
     Next i 
    End With 
End Sub 

하는 선호 행, 예를 들어,에서 시작해야합니다 : 내 테스트 코드에

건물, 그냥 복사 라인에 열을 행에서 I를 이동해야 이 테스트 코드는 1 행의 열을 반복합니다.

Answer 2

마지막 답글을 기반으로 한 새로운 테스트 코드입니다.

수평으로 (I58, J58, K58 ...) 대신 세로로 (I58, I59, I60 ...)를 복사합니다.)

소스 및 대상 파일별로 적절한 열과 셀로 이동하도록 참조가 변경되었습니다.

저는 j가 열 대신 행을 복사한다고 생각합니다. H 열을 선택하고 D와 E로 수식을 계산하고 특수한 복사하여 붙여 넣기하려고합니다.

UPDATE 이 코드는 작동하지만 그것은 단지 마지막 섹션 열을 입력으로 정지 (H : H)

Sub Macroloco_() 
Dim wbBook1 As Workbook 
Dim wbBook2 As Workbook 

Set wbBook1 = ThisWorkbook 
Set wbBook2 = Workbooks.Open("C:\reports Sep\week38.xls") 

Dim wsSheet1 As Worksheet 
Dim wsSheet2 As Worksheet 
Set wsSheet1 = wbBook1.Worksheets("01") 
Set wsSheet2 = wbBook2.Worksheets("report") 

Dim i As Long, j As Long, k As Long 
With wsSheet2 
    j = .Cells(1, .Columns.Count).End(xlToLeft).Column 
    k = 36 
    For i = 9 To j 
     .Cells(58, i).Copy 
     wsSheet1.Cells(k, 4).PasteSpecial xlPasteAll 
     k = k + 9 
    Next i 
End With 

Columns("H:H").Select 
Selection.SpecialCells(xlCellTypeConstants, 1).Select 
Selection.FormulaR1C1 = "=RC[-4]-RC[-3]" 
Columns("H:H").Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Columns("I:I").Select 
Selection.SpecialCells(xlCellTypeConstants, 1).Select 
Selection.ClearContents 
Range("J9").Select 
Application.CutCopyMode = False 

End Sub