Creating a macro that copies certain cells and places them into columns - vba

Question

I have 26 worksheets every week that contain a "Station #", "Latitude#", and a "Longitude#".
I want to create a Macro that grabs these 3 cells, copies them and places them into 3 columns named "Station #", "Lat", and "Long.
I'm not very good at this so i need some help.
This is what i got so far:
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
I cant seem to figure out how to paste the next worksheet i open in the next fields ( such as A3, B3, C3 and so forth.
Please help me!

Answer 1

Try this:
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
Above code basically opens all .xlsx file in the specified folder and then copies static ranges. This static ranges are the ones you specified in your question (e.g. Range("C8:D8")). So it copies it and paste it as values on the sheet you will specify. It finds the last row on the destination sheet which will put the copied values below it.
Is this what you're trying? HTH.