Question

我有以下代码。代码将进入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

提前谢谢

Answer 1

每个工作簿只计算一次Matcher matcher = Pattern.compile("[a-zA-Z]") .matcher(s); int counter = 0; while (matcher.find()) { counter++; } if (counter <= 1) { System.out.println("None / Only 1"); } else { System.out.println("More than 1"); }，然后将其用于所有列：

NextRow

Answer 2

实际上你想要每张一行。没有其他的。而已。你甚至不需要计算它。你需要增加它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

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

The line Dim lngRow as Long: lngRow=1与其他Dim

lngRow = lngRow + 1

With wb.Sheets("Open Issue Actions")
粘贴值应与此.Cells(lngRow, myCol).PasteSpecial xlPasteValues

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

我们的想法是拥有lngRow并为您打开的每个WorkSheet增加它。并且不要做任何其他事情。

一般情况下，您的代码可以通过某些方式进行优化，如果在更改后工作正常，请将其放在此处以获取更多想法：https://codereview.stackexchange.com/

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

2 个答案: