Question

我每周有26张工作表，其中包含一个＆＃34; Station＃＆＃34;，＆＃34; Latitude＃＆＃34;和一个＆＃34;经度＃＆＃34;。我想创建一个抓取这3个单元格的宏，复制它们并将它们放入3列名为＆＃34; Station＃＆＃34;，＆＃34; Lat＆＃34;和＆＃34; Long。我不是很擅长，所以我需要一些帮助。这是我到目前为止所得到的：

Sub Macro1()

FolderName = "C:\Users\Captain Wypij\Desktop\Traffic\test"
If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
Fname = Dir(FolderName & "*.xls")

    'loop through the files
Do While Len(Fname)

    With Workbooks.Open(FolderName & Fname)

Range("C8:D8").Select
Selection.Copy
ChDir "C:\Users\Captain Wypij\Desktop\Traffic"
Workbooks.Open Filename:= _
    "C:\Users\Captain Wypij\Desktop\Traffic\Test.xls.xlsx"
Range("A2").Select
If ("A2") = "*" Then Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Workbooks.Open (FolderName & Fname)
ActiveWindow.SmallScroll Down:=12
Range("C34:D34").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls.xlsx").Activate
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Workbooks.Open (FolderName & Fname)
Range("G34:H34").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls.xlsx").Activate
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Workbooks.Open (FolderName & Fname)
 ActiveWindow.Close

 Windows("Test.xls.xlsx").Activate
ActiveWorkbook.Save
ActiveWindow.Close

End With
    ' go to the next file in the folder
    Fname = Dir
Loop
End Sub

我似乎无法弄清楚如何粘贴我在下一个字段中打开的下一个工作表（例如A3，B3，C3等等）。请帮我！

Answer 1

试试这个：

Dim FolderName As String, Fname As Variant
FolderName = "C:\Location\Folder\"
Fname = Dir(FolderName & "*.xlsx")
Dim wb As Workbook, ws As Worksheet, lr as long

Do While Fname <> ""
    Set wb = Workbooks.Open(FolderName & Fname)
    Set ws = wb.Sheets("SheetName") '~~> Change to suit
    With Thisworkbook.Sheets("Sheet1") '~~> Change to suit
        lr = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        ws.Range("C8:D8").Copy: .Range("A" & lr).PasteSpecial xlPasteValues
        ws.Range("C34:D34").Copy: .Range("B" & lr).PasteSpecial xlPasteValues
        ws.Range("G34:H34").Copy: .Range("C" & lr).PasteSpecial xlPasteValues
    End With
    wb.Close False
    Set wb = Nothing: Set ws = Nothing
    Fname = Dir
Loop

以上代码基本打开指定文件夹中的所有 .xlsx 文件，然后复制静态范围。
此静态范围是您在问题中指定的范围（例如Range("C8:D8") ）。所以它将它复制并粘贴在你指定的纸张上。
它找到目标纸上的最后一行，它将复制的值放在它下面。
这是你在尝试的吗？ HTH。

创建一个复制某些单元格并将它们放入列的宏

1 个答案: