Question

我从几个不同的数据库导入数据并将它们组合成一个简单的报告，但是所有数据库都有不同的布局，例如1个数据库的名称在第1列中，第二个在第2列中有名称

我在论坛中找到了一些很好的例子，但是将它们绑定到导入器中并没有产生正确的结果。

此代码以正确的顺序调用我需要的所有列，但是它将它们全部放在1列

中

Sub importoer()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Dim v As Long, vcols As Variant

Set wb1 = ActiveWorkbook
Set PasteStart = [oer!A1]
vcols = Array(1, 2, 11, 4, 6, 7, 10, 3) 'columns to copy in this order

Sheets("oer").Select
Cells.Select
Selection.ClearContents
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose OER File", _
FileFilter:="All Files (*.*),*.*")

If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else

Set wb2 = Workbooks.Open(Filename:=FileToOpen)
For Each Sheet In wb2.Sheets
    With Sheet.UsedRange.Cells(1, 1).CurrentRegion
    For v = LBound(vcols) To UBound(vcols)
        .Columns(vcols(v)).Copy
        PasteStart.PasteSpecial xlPasteValues
    Set PasteStart = PasteStart.Offset(.Rows.Count)
    Next v
    '.Copy

End With
Next Sheet
End If
Application.CutCopyMode = False
wb2.Close SaveChanges:=False
End Sub

所以我通过更改pastestart定义

在目标页面上添加列选择

Set PasteStart = PasteStart.Cells(1, v + 1)

这会调用除第一列以外的所有列，并将它们放在OER表上，每列之间都有空列。

第1列未复制第2栏放在第1栏第11栏放在第2栏第4栏放在第4栏第6列放在第7栏中，所以

我需要弄清楚如何在呼叫顺序

中将它们全部放在第1列到第8列中

有什么想法吗？

＆GT;

Answer 1

也许这个？您按行而不是列

进行偏移

Sub importoer()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Dim v As Long, vcols As Variant

Set wb1 = ActiveWorkbook
Set PasteStart = wb1.Sheets("oer").Range("A1")
vcols = Array(1, 2, 11, 4, 6, 7, 10, 3) 'columns to copy in this order

wb1.Sheets("oer").UsedRange.Cells.ClearContents
FileToOpen = Application.GetOpenFilename(Title:="Please choose OER File", _
            FileFilter:="All Files (*.*),*.*")
If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb2 = Workbooks.Open(Filename:=FileToOpen)
    For Each Sheet In wb2.Sheets
        With Sheet
            For v = LBound(vcols) To UBound(vcols)
                .Columns(vcols(v)).Copy
                PasteStart.PasteSpecial xlPasteValues
                Set PasteStart = PasteStart.Offset(, 1)
            Next v
        End With
    Next Sheet
End If

Application.CutCopyMode = False
wb2.Close SaveChanges:=False

End Sub

复制数据列而不将列从一个工作簿跳到编译工作簿

1 个答案: