Hi, Im sturggling finding a way to copy the code a9:g greatest row aswell as copying the cell B2.
Heres my code so far
im assuming 'Range("a9:G" & GreatestRow).Copy' is the line that needs adding to, ive tried loads of combinations like 'Range("a9:G" & GreatestRow, "b2").Copy' and
'Range("a9:G" & GreatestRow).Copy'
'Range("b2").Copy'
But just cant see to work this one out!
Help much appreciated - thanks!
Heres my code so far
Code:
Sub Move_to_master()
Dim wb As Workbook
Dim TheFile As String
Dim MyPath As String
MyPath = GetFolder
ChDrive Left(MyPath, Application.WorksheetFunction.Search(":", MyPath))
ChDir MyPath
TheFile = Dir("*.xls")
On Error Resume Next
Do While TheFile <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
GreatestRow = Cells(Rows.Count, 1).End(xlUp).Row
If Cells(Rows.Count, 2).End(xlUp).Row > GreatestRow Then
GreatestRow = Cells(Rows.Count, 2).End(xlUp).Row
End If
If Cells(Rows.Count, 3).End(xlUp).Row > GreatestRow Then
GreatestRow = Cells(Rows.Count, 3).End(xlUp).Row
End If
If Cells(Rows.Count, 4).End(xlUp).Row > GreatestRow Then
GreatestRow = Cells(Rows.Count, 4).End(xlUp).Row
End If
Windows(TheFile).Activate
Range("a9:G" & GreatestRow).Copy
Windows("Master.xlsx").Activate
LR = Cells(Rows.Count, 1).End(xlUp).Row
If Cells(Rows.Count, 2).End(xlUp).Row > LR Then
LR = Cells(Rows.Count, 2).End(xlUp).Row
End If
If Cells(Rows.Count, 3).End(xlUp).Row > LR Then
GreatestRow = Cells(Rows.Count, 3).End(xlUp).Row
End If
If Cells(Rows.Count, 4).End(xlUp).Row > LR Then
LR = Cells(Rows.Count, 4).End(xlUp).Row
End If
Range("a" & LR + 1).Select
Sheet1.Paste
wb.Close Savechanges:=False
Application.ScreenUpdating = True
TheFile = Dir
Loop
End Subim assuming 'Range("a9:G" & GreatestRow).Copy' is the line that needs adding to, ive tried loads of combinations like 'Range("a9:G" & GreatestRow, "b2").Copy' and
'Range("a9:G" & GreatestRow).Copy'
'Range("b2").Copy'
But just cant see to work this one out!
Help much appreciated - thanks!