Copy and paste not working for macro

[Jackel]

Hello all,

I am having an issue with my macro that I cannot figure out. I spent a few hours Friday trying to break it up, but it into different sections, but nothing worked :banghead:. It is rather long, but in short, it loops through a folder copying and pasting the same columns of data, into one master file.

The problem is, that it gets the first copy and paste section right which is A:E, then it moves over to S:U, but it will not copy the last ones. Instead it copies over column E into column U. Any input or corrections that you can see that need to be made? *One of the last sections is ' out because I was trying to work section by section to solve the problem.

I am monitoring this post very closely so I will be in constant communication as others reply. Thanks!


Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xls?"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents



'ENTER USER CODE HERE
Worksheets("Pricing Entry").Activate
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
'Worksheets("Lane Pricing Entry").ShowAllData
'On Error Resume Next
Dim myColm As Range
Set myColm = Range("R:R")
On Error Resume Next
myColm.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Dim wb As Workbook
'Set wb = Workbooks("Eagle Foods TL Bid Tool v1.xlsm")
'


'Lane ID
Dim LRpg1 As Integer
LRpg1 = Range("A" & Rows.Count).End(xlUp).Row
Range("A3:D" & LRpg1).Select
Selection.Copy
'Ignores blank rows, could be handy for when import doesnt delete blank rows


Windows("Master.xlsm").Activate
Sheets("Data Entry").Select
lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
Range("C" & lMaxRows + 1).Select
ActiveSheet.Paste
Range("C3").Select
Application.CutCopyMode = False


'Origin city, State, zip
Dim LRpg3 As Integer
LRpg3 = Range("I" & Rows.Count).End(xlUp).Row
Range("I3:J").Select
Selection.Copy




Windows("Master.xlsm").Activate
Sheets("Data Entry").Select
lMaxRows = Cells(Rows.Count, "S").End(xlUp).Row
Range("S" & lMaxRows + 1).Select
ActiveSheet.Paste



'Destination City,State,Zip

LRpg4 = Range("G" & Rows.Count).End(xlUp).Row
Range("G3:I" & LRpg1).Select
Selection.Copy


Windows("Master.xlsm").Activate
Sheets("Data Entry").Select
lMaxRows = Cells(Rows.Count, "G").End(xlUp).Row
Range("G" & lMaxRows + 1).Select
ActiveSheet.Paste


'Volume and Milage
wb.Worksheets(1).Activate
Dim LRpg5 As Integer
LRpg5 = Range("I" & Rows.Count).End(xlUp).Row
Range("I3:J" & LRpg5).Select
Selection.Copy


Windows("Master").Activate
Sheets("Data Entry").Select
lMaxRows = Cells(Rows.Count, "Q").End(xlUp).Row
Range("Q" & lMaxRows + 1).Select
ActiveSheet.Paste

'RPM and MIN
'Dim LRpg6 As Integer
'LRpg6 = Range("S" & Rows.Count).End(xlUp).Row
'Range("S3:T" & LRpg6).Select
'Selection.Copy



'wb.Worksheets.Activate
'Windows("Master.xlsm").Activate
'Sheets("Data Entry").Select
'lMaxRows = Cells(Rows.Count, "U").End(xlUp).Row
'Range("U" & lMaxRows + 1).Select
ActiveSheet.Paste

'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

[Kenneth Hobs]

You can use F8 to execute one line at a time. Or, add a debug stop at a line and then execute one line at a time so you can see what is going on.

I notice that you are copying multiple columns and then pasting to one cell. As such, the same number of column get pasted too. That may be your issue.

It was hard to see what all was going on since you used so many Activate and Select. Seldom are those needed. Code is easier to debug when you condense it. I did the first two copy/pastes for you.


Option Explicit

Sub Main()
Dim wb As Workbook
Dim myPath As String, myFile As String, myExtension As String
Dim FldrPicker As FileDialog
Dim myColm As Range, LRpg1 As Long, LRpg2 As Long, LRpg3 As Long
Dim mWS As Worksheet, ws As Worksheet

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
If myPath = "" Then GoTo ResetSettings

Set mWS = ThisWorkbook.Worksheets("Data Entry")


'Target File Extension (must include wildcard "*")
myExtension = "*.xls?"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents

'ENTER USER CODE HERE
Set ws = Worksheets("Pricing Entry")
If (ws.AutoFilterMode And ws.FilterMode) Or ws.FilterMode Then ws.ShowAllData



On Error Resume Next
Range("R:R").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
'Dim wb As Workbook
'Set wb = Workbooks("Eagle Foods TL Bid Tool v1.xlsm")
'


'Lane ID
Range("A3:D" & Range("A" & Rows.Count).End(xlUp).Row).Copy _
mWS.Range("C" & Rows.Count).End(xlUp).Offset(1)


'Origin city, State, zip
Range("I3:J" & Range("I" & Rows.Count).End(xlUp).Row).Copy _
mWS.Range("S" & Rows.Count).End(xlUp).Offset(1)


'Get next file name
myFile = Dir
Loop




'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub