크기 조정 셀 열 행

Question

나는 오류 (1004)가 계속의 다중 선택을 복사 할 때이 코드에 "복사 영역은 같은 크기/모양 아니다"

내가했습니다 시도 장소에서 다양한 .pastespecials, .selection.autofit를 삽입 ....하지만 나는 어둠 속에서 좀 찔러 다녔다.

도움 말?

Sub SaveData() 

Dim rr As Range 
Set rr = Selection 

For Each Row In rr 

    'error occurs here' 
    Range("a" & i & ":BN" & i).Copy Worksheets("ArchiveData").Cells(Worksheets("ArchiveData").Rows.Count, "b").End(xlUp).Offset(1, 0) 
    Sheets("ArchiveData").Cells(Worksheets("archivedata").Cells(Rows.Count, 2).End(xlUp).Row, 1).Value = Date 



    Next Row 

최종 하위 EXPLICIT 모든 사용 옵션의

Answer 1

먼저! (도구> 옵션> 편집기> 변수 선언 요구)에 명시 적 옵션 분명했을 것이다이 특정 문제에 대한 지금

(. For Each Row In rr에서

은하지 변수 또는 객체로 볼 수있다 범위 RR의 행. 사용할 필요

이제 다음 i이 dimensi되지 않는 문제가

Dim rr As Range 
Dim rrrow as Range 

Set rr = Selection 

For Each rrrow In rr.Rows 

입니다 따라서 대부분의 아마 내가 당신과 같이 진행하고자합니다 생각

을 제로 또는 비어 (0 또는 ""또는 NULL) 것, 값이 중 하나에 +1, 심지어 나던 :

rrrow.Copy 
With Worksheets("ArchiveData") 
    .Range(........).PasteSpecial 'HERE YOU ONLY NEED TO SPECIFY THE TOP LEFT MOST CELL 
End With 

Answer 2

을 아래에보십시오 code :

Sub SaveData() 

    Dim rr As Range 
    Set rr = Selection 


    Dim wsht As Worksheet 
    On Error Resume Next 
    Set wsht = Worksheets("ArchiveData") 
    On Error GoTo 0 

    If wsht Is Nothing Then Exit Sub 

    For i = 1 To rr.Rows.Count 

     Range("a" & i & ":BN" & i).Copy wsht.Cells(wsht.Range("B65000").End(xlUp).Row + 1, 2) 
     wsht.Cells(wsht.Cells(Rows.Count, 2).End(xlUp).Row, 1).Value = Date 

    Next 
End Sub