使用vba / macro将特定列中的数据和多个excel文件中的多行复制为1

时间:2014-09-11 11:44:54

标签: sql excel vba excel-vba

希望有人可以帮助我,我正在开展一个工作项目,我已经碰到了一堵砖墙。我是编码的新手,通过各种试验和研究,我编写了一个代码,它只是我需要的部分内容。

原理很简单,我有几百张Excel工作表,我想将特定列的数据拉入带有列标题的新工作表中。到目前为止,我的代码从目录中的每个文件中拉出第一行,但是我需要这个来读取所有行,直到它变为空白,这可能会有很大差异,这就是为什么我不能使用标准范围。

到目前为止,这是我的代码:

Sub LoopThroughFiles()
Dim MyFolder As String 
Dim FiletoList As String 
Dim NextRow As Long 

On Error Resume Next

Application.ScreenUpdating = False
Application.DisplayAlerts = False


With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False

If .SelectedItems.Count = 0 Then
    MsgBox "You did not select a folder"
    Exit Sub
End If
MyFolder = .SelectedItems(1) & "\"
End With


FiletoList = Dir(MyFolder & "Marking Sheet Ref*.xls")
Range("A1").Value = "Sitting Number"
Range("B1").Value = "Student Name"
Range("C1").Value = "Member Number"
Range("D1").Value = "1"
Range("E1").Value = "2"
Range("F1").Value = "3"
Range("G1").Value = "4"
Range("H1").Value = "5"
Range("I1").Value = "6"
Range("J1").Value = "7"
Range("K1").Value = "8"
Range("L1").Value = "9"
Range("M1").Value = "10"
Range("N1").Value = "11"
Range("O1").Value = "12"
Range("P1").Value = "13"
Range("Q1").Value = "14"
Range("R1").Value = "15"
Range("S1").Value = "16"
Range("T1").Value = "17"
Range("U1").Value = "18"
Range("V1").Value = "Total % Mark"
Range("W1").Value = "Final Grade"
Range("X1").Value = "Moderator % Mark"
Range("Y1").Value = "Moderator Final Grade"
Range("Z1").Value = "Unit Code"
Range("AA1").Value = "Program Code"
Range("AB").Value = "Marker Name"
Range("AC1").Value = "Country"

'Find the next empty row in the list
NextRow = Application.CountA(Range("A:A")) + 1
NextRow = NextRow + 1 ' skip a line

'Do whilst the dir function returns an Excel workbook
 Do While FiletoList <> ""
 Cells(NextRow, 1).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C1"
Cells(NextRow, 2).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C2"
Cells(NextRow, 3).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C3"
Cells(NextRow, 4).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C5"
Cells(NextRow, 5).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C6"
Cells(NextRow, 6).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C7"
Cells(NextRow, 7).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C8"
Cells(NextRow, 8).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C9"
Cells(NextRow, 9).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C10"
Cells(NextRow, 10).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C11"
Cells(NextRow, 11).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C12"
Cells(NextRow, 12).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C13"
Cells(NextRow, 13).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C14"
Cells(NextRow, 14).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C15"
Cells(NextRow, 15).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C16"
Cells(NextRow, 16).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C17"
Cells(NextRow, 17).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C18"
Cells(NextRow, 18).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C19"
Cells(NextRow, 19).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C20"
Cells(NextRow, 20).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C21"
Cells(NextRow, 21).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C22"
Cells(NextRow, 22).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C23"
Cells(NextRow, 23).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C24"
Cells(NextRow, 24).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C32"
Cells(NextRow, 25).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C33"
Cells(NextRow, 26).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C25"
Cells(NextRow, 27).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C27"
Cells(NextRow, 28).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C30"
Cells(NextRow, 29).Formula = "='" & MyFolder & "[" & FiletoList & "]Marking Sheet'! R11C31"
NextRow = NextRow + 1 'Move to next row
FiletoList = Dir 'Dir returns the next Excel workbook in the folder
Loop

Application.ScreenUpdating = True

End Sub

这将返回我希望复制数据的每个Excel工作表的第一行(第11行),但可能有1行或1000行。所有这些数据都需要被捕获,我无法弄清楚我错过了什么。任何帮助将不胜感激。它必须特定于从第11行开始,并且提供的列也特定于要求。

1 个答案:

答案 0 :(得分:0)

看起来你需要在你已经定义的循环中进行第二次循环。您的代码获取一行数据,然后转到下一个文件。

内部循环需要确定范围内的行数(正如您已经确定的那样)。这段代码就是这样做的一种方式(对于Sheet中的一个范围,称为&#34;数据&#34;)。

   endRowNo = Sheets("Data").Cells(.Rows.Count, ColNo).End(xlUp).Row

您可以通过一次性复制整个数据范围,而不是循环遍历行,假设它符合您的需要,可以缩短代码。

See this link

你也可以考虑使用一个循环来填充你的&#34;数字&#34;标题以缩短您的代码。值得学习/使用单元格表示法可以更容易地操作循环中的范围。

Check out this link

最后,在使用ON ERROR RESUME NEXT时要小心,这可能会隐藏编码错误并使解决它们变得更加困难。您可能会发现有关基本错误处理的有用信息。

This link may help

希望这有帮助。