2015-07-31 4 views
1

Я могу скопировать последнюю строку одной книги и вставить ее после последней строки другой книги. Я хочу скопировать все данные из строки 2 (строка 1 в виде заголовка) в первую книгу и вставить ее после последней строки другой книги. Пожалуйста, сообщите мне, какие изменения необходимы в приведенном ниже коде, чтобы скопировать все данные из строки 2, а не только последнюю строку.Скопируйте данные листа в конец другого листа

Dim lastS1Row As Long  
Dim nextS2Row As Long  
Dim lastCol As Long   
Dim lCol As Long 
Dim lCol1 As Long 
Dim s1Sheet As Worksheet, s2Sheet As Worksheet 
Dim source As String   
Dim target As String   
Dim path As String 
Dim path1 As String 

    source = "Students"  'Source Worksheet Name 
    path1 = "H:\Shaikh_Gaus\scratch\VBA\Book17.xlsx" 
    path = "H:\Shaikh_Gaus\scratch\VBA\Book16.xlsx" 
    target = "Students" 'Target Worksheet Name 

    Application.EnableCancelKey = xlDisabled  


    Set s1Sheet = Workbooks.Open(path).Sheets(source) 
    Set s2Sheet = Workbooks.Open(path1).Sheets(target) 

    lastS1Row = s1Sheet.Range("A" & Rows.Count).End(xlUp).Row 
    nextS2Row = s2Sheet.Range("A" & Rows.Count).End(xlUp).Row + 1 
    lastCol = s1Sheet.Cells(1, Columns.Count).End(xlToLeft).Column 

    For lCol = 1 To lastCol 
     s2Sheet.Cells(nextS2Row, lCol) = s1Sheet.Cells(lastS1Row, lCol) 
    Next lCol 
    Next lCol1 

    s2Sheet.Activate 
    ActiveWorkbook.Close SaveChanges:=True 
    s1Sheet.Activate 
    ActiveWorkbook.Close 
+1

Обновите форматирование своего кода, так как он нечитабелен. – Soulfire

+1

Обновлено сэр .... –

ответ

-1
'Here you go: 

Range("A2").End(xlDown).select 
selection.End(xlRight).select 
selection.copy 
'then active the next sheet for e.g Sheet2.Active 
last_row = range("A1048576").end(xlup).row 
range("A" & last_row).paste 

' Done 
+0

Можете ли вы предоставить мне полное кодирование. Я не уверен, куда вставить исправленную кодировку в мою программу –

+0

Мое извинение, я получаю ошибку. Пожалуйста, предоставьте мне полный код –

+0

Пожалуйста, помогите мне. Я почти сделал с моим проектом –

0

Это скорректированный вариант кода должен делать эту работу:

Dim s1Sheet As Worksheet, s2Sheet As Worksheet 
Dim source As String 
Dim target As String 
Dim path As String 
Dim path1 As String 
Dim rngSource As Range 
Dim rngTargetStart As Range 

    source = "Students"  'Source Worksheet Name 
    path1 = "H:\Shaikh_Gaus\scratch\VBA\Book17.xlsx" 
    path = "H:\Shaikh_Gaus\scratch\VBA\Book16.xlsx" 
    target = "Students" 'Target Worksheet Name 

    Application.EnableCancelKey = xlDisabled 

    Set s1Sheet = Workbooks.Open(path).Sheets(source) 
    Set s2Sheet = Workbooks.Open(path1).Sheets(target) 
    Set rngSource = Range(s1Sheet.Range("A2"), s1Sheet.Cells.SpecialCells(xlCellTypeLastCell)) 
    Set rngTargetStart = s2Sheet.Range("A" & Rows.Count).End(xlUp).Offset(1) 

    rngTargetStart.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value 

    s2Sheet.Parent.Close SaveChanges:=True 
    s1Sheet.Parent.Close 

я снял что-то, что казалось ненужным. Главное, что теперь вы не перебираете столбцы и строки. Теперь вы можете сделать это с одной операцией.

Избегайте столько, сколько вы можете, например .Select, .Activate. и .Copy, если вам нужны только значения, которые нужно вставить. Вы можете просто сделать что-то подобное, как я сделал:

Target.Value = Source.Value 
0

После установки s1Sheet и s2Sheet Я думаю, вы должны быть в состоянии использовать эти 2 строки, чтобы скопировать & вставить весь диапазон сразу:

'copy Cells A2 through last row and last column used 
    s1Sheet.Range(s1Sheet.Cells(2, 1), s1Sheet.Cells(s1Sheet.Cells(s1Sheet.Rows.Count, 1).End(xlUp).Row, _ 
    s1Sheet.Cells(1, s1Sheet.Columns.Count).End(xlToLeft).Column)).Copy 

    'paste those cells in next blank row of second sheet 
    s2Sheet.Cells(s2Sheet.Cells(s2Sheet.Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteAll 
Смежные вопросы