从多个电子表格中复制列。当电子表格中的列为空时，数据向上移动

I have the below code. The code will go into each of the 17 workbooks and extract certain columns based on the columns headers name. This will repeat and add to the bottom of the master workbook, until the last one has been extracted. Unfortunately, if there is nothing in one of the columns on one of the individual 17 workbooks, the data from the next workbook gets moved up in the cells. Is there anyway to sort this. I have added the code below.

我有下面的代码。代码将进入17个工作簿中的每个工作簿，并基于列标题名提取某些列。这将重复并添加到主工作簿的底部，直到最后一个被提取。不幸的是，如果单个17个工作簿中的一个列中没有任何内容，那么来自下一个工作簿的数据将在单元格中向上移动。有没有办法把这个分类。我已经添加了下面的代码。

Option Explicit
Sub CopyColumns()
Dim CopyFromPath As String, FileName As String
Dim CopyToWb As Workbook, wb As Workbook, CopyToWs As Worksheet
Dim lastRow As Long, NextRow As Long, lcol As Long, c As Long, sv As Integer
Dim ws As Worksheet
Dim myCol As Long
Dim myHeader As Range
r\"
Set CopyToWb = ActiveWorkbook
Set c).End(xlUp).Row
                    If lastRow = 1 Then GoTo nxt

                    Range(Cells(2, c), Cells(lastRow, c)).Copy
                    CopyToWs.Activate
                    Set myHeader = CopyToWs.Rows(1).Find(What:=.Cells(1, c).Value, Lookat:=xlWhole)
                    With CopyToWs
                        If Not myHeader Is Nothing Then
                            myCol = myHeader.Column
                            NextRow = .Cells(Rows.Count, myCol).End(xlUp).Row + 1
                            .Cells(NextRow, myCol).PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                            Set myHeader = Nothing
                        End If
nxt:
                    End With
                End If
            Next c
    wb.Close saveChanges:=False
    End With
    FileName = Dir
Loop
Application.ScreenUpdating = True
End Sub

Thank you in advance

提前谢谢你

2 个解决方案

#1

Calculate NextRow only once per workbook, and then use it for all columns:

每个工作簿只计算一次NextRow，然后对所有列使用它:

Do While Len(FileName) > 0
    'Calculate the next row to be populated for all columns, based on the last
    'used cell in column A
    '(I used column A, but pick whatever destination column will always be
    'populated in every workbook.)
    With CopyToWs
        NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    'Process this workbook
    Set wb = Workbooks.Open(CopyFromPath & FileName)
    With wb.Sheets("Open Issue Actions")
        lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For c = 1 To lcol
            '...
                With CopyToWs
                    If Not myHeader Is Nothing Then
                        myCol = myHeader.Column
                        'NextRow = .Cells(Rows.Count, myCol).End(xlUp).Row + 1
                        .Cells(NextRow, myCol).PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                        Set myHeader = Nothing
                    End If
                End With
nxt:
                '...

#2

Actually you want one row per sheet. Nothing else. Nothing more. You do not even need to calculate it. You need to increment it lngRow = lngRow+1. Try to use the following into your code:

实际上，你想要每行。什么都没有。仅此而已。你甚至不需要计算它。你需要增加它lngRow = lngRow+1。试着在你的代码中使用以下内容:

Option Explicit

Sub CopyColumns()

    Dim lngRow  As Long: lngRow = 1

    Do While Len(FileName) > 0
        Set wb = Workbooks.Open(CopyFromPath & FileName)
        With wb.Sheets("Open Issue Actions")
            lngRow = lngRow + 1

            With CopyToWs
                If Not myHeader Is Nothing Then
                    myCol = myHeader.Column
                    .Cells(lngRow, myCol).PasteSpecial xlPasteValues
                    Set myHeader = Nothing
                End If
            End With
        End With
        wb.Close saveChanges:=False
    Loop
    Application.ScreenUpdating = True

End Sub

In the code you add/edit three things:

在代码中添加/编辑三件事:

The line Dim lngRow as Long: lngRow=1 on top with the other Dim
线变暗长:线变长=1，另一边变暗
lngRow = lngRow + 1 after the With wb.Sheets("Open Issue Actions")
lngRow = lngRow + 1。表(“开放问题行为”)
the paste values should be like this .Cells(lngRow, myCol).PasteSpecial xlPasteValues
粘贴值应该像这样。cells (lngRow, myCol)。PasteSpecial xlPasteValues

The whole code is here: https://pastebin.com/kXdzkGZ1

整个代码在这里:https://pastebin.com/kXdzkGZ1

The idea is to have lngRow and to increment it for every WorkSheet that you open. And do not do anything else with it.

其思想是让lngRow并为打开的每个工作表增加它。不要用它做任何事情。

In general, your code can be optimized in some ways, if it works ok after the change, put it here for further ideas: https://codereview.stackexchange.com/

一般来说，您的代码可以在某些方面进行优化，如果在更改之后可以正常工作，请将其放在这里以获取进一步的想法:https://codereview.stackexchange.com/。

#1