Невозможно вставить столбец, кроме 1-го ряда, в другую книгу Excel с помощью Excel VBA - PullRequest
0 голосов
/ 03 мая 2018

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

Set Wb1 = Workbooks(Wb1name)
Sheetname = Wb1.ActiveSheet.Name

Set Wb2 = Workbooks("Worksheet2.xlsm")


'Find the last non-blank cell in row 1
l1Col = Wb1.Worksheets(Sheetname).Cells(1, Columns.Count).End(xlToLeft).Column
l1Row = Wb1.Worksheets(Sheetname).Cells(Rows.Count, 1).End(xlUp).Row
l2Col = Wb2.Worksheets(Sheetname).Cells(1, Columns.Count).End(xlToLeft).Column
l2Row = Wb2.Worksheets(Sheetname).Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To l1Col
    For j = 1 To l2Col
        If "       " & Wb1.Worksheets(Sheetname).Cells(1, i).Value = Wb2.Worksheets(Sheetname).Cells(1, j).Value Then

            '''If header matches in both excels then copy column to destination excel'''
             'This is working but entire column copied
             Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Columns(i)
            '' This dosent work
            'Wb2.Worksheets(Sheetname).Range(Cells(2, j), Cells(l2Row, j)).Copy Destination:=Wb1.Worksheets(Sheetname).Range(Cells(2, i), Cells(l1Row, i)) 


        End If
    Next j
Next i

Ответы [ 2 ]

0 голосов
/ 03 мая 2018

Изменение:

Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Columns(i)

Кому:

Wb2.Worksheets(Sheetname).Range(Chr(j + 64) & "2:" & Chr(j + 64) & Wb2.Cells(Wb2.Rows.Count, "C").End(xlUp).Row).Copy Destination:=Wb1.Worksheets(Sheetname).Range(Chr(i + 64) & "2")
0 голосов
/ 03 мая 2018

Вы должны вставить в ячейку / диапазон, и, поскольку вы копируете целый столбец, вы должны вставить его в первый ряд целевого столбца.

Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Cells(1, i)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...