VBA- Paste into next open column

[moball45]

I have a simple macro, but need to add a piece to it that will tell it to paste my data in the next open column, but with the same Row reference each time (same starting point).

For example, if on week 1 the data pastes in Column CU88:CU119, on week 2 I want it to auto paste into Column CV88:CV119, but I don't want to have to manually change "CU" to "CV" to "CW," etc as my weeks progress. I have 4 separate chunks of data that are set to copy/paste, but those ranges per column won't be changing each week, just the actual column it pastes into.

Below is my current macro that is working to paste correctly, but right now I'd have to replace my column reference each week:


Sub ManningOTOnly()
Application.ScreenUpdating = False

Dim excel As excel.Application
Dim wb As excel.Workbook
Dim sht As excel.Worksheet
Dim q As Object

Set q = Application.FileDialog(3)
q.AllowMultiSelect = False
q.Show

Set excel = CreateObject("excel.Application")
Set wb = excel.Workbooks.Open(q.SelectedItems(1))
Set sht = wb.Worksheets("Manning for Quicklooks")

sht.Activate
sht.Range("C3:C51").Offset(0, 0).Copy
Sheets("Raw Data").Range("CU88").PasteSpecial Paste:=xlPasteValues

sht.Activate
sht.Range("D3:D34").Offset(0, 0).Copy
Sheets("Raw Data").Range("CU221").PasteSpecial Paste:=xlPasteValues

sht.Activate
sht.Range("E3:E34").Offset(0, 0).Copy
Sheets("Raw Data").Range("CU337").PasteSpecial Paste:=xlPasteValues

sht.Activate
sht.Range("F3:F34").Offset(0, 0).Copy
Sheets("Raw Data").Range("CU453").PasteSpecial Paste:=xlPasteValues

Application.ScreenUpdating = True

wb.Close
End Sub


Thank you for your help!

 

[JLGWhiz]

See if this works.

Sub ManningOTOnly()
 Application.ScreenUpdating = False
 Dim excel As excel.Application
 Dim wb As excel.Workbook
 Dim sht As excel.Worksheet, lc As Long
 Dim q As Object
 Set q = Application.FileDialog(3)
 q.AllowMultiSelect = False
 q.Show
 Set excel = CreateObject("excel.Application")
 Set wb = excel.Workbooks.Open(q.SelectedItems(1))
 Set sht = wb.Worksheets("Manning for Quicklooks")
 lc = Sheets("Raw Data").Cells(88, Columns.Count).End(xlToLeft).Column
	If lc < 73 Then lc = 73
 sht.Activate
 sht.Range("C3:C51").Copy
 Sheets("Raw Data").Cells(88, lc.PasteSpecial Paste:=xlPasteValues
 sht.Activate
 sht.Range("D3:D34").Copy
 Sheets("Raw Data").Cells(221, lc).PasteSpecial Paste:=xlPasteValues
 sht.Activate
 sht.Range("E3:E34").Copy
 Sheets("Raw Data").Cells(337, lc).PasteSpecial Paste:=xlPasteValues
 sht.Activate
 sht.Range("F3:F34").Copy
 Sheets("Raw Data").Cells(453, lc).PasteSpecial Paste:=xlPasteValues
 Application.ScreenUpdating = True
 wb.Close
 End Sub

 

[moball45]

Thanks for your reply, but it doesn't seem to have worked. It appears that it just pasted the data over my original Column "CU" data that was already in my spreadsheet.

Right now I have data filled in all columns, through CU and I have my CV column blank. Hoping the data can paste in CV for this week and then next week I'll insert a new column to the right (CW), etc continuing each week the same format.

Thank you again.

 

[JLGWhiz]

My error, should have added one to the value of lc. Try this.

Sub ManningOTOnly()
 Application.ScreenUpdating = False
 Dim excel As excel.Application
 Dim wb As excel.Workbook
 Dim sht As excel.Worksheet, lc As Long
 Dim q As Object
 Set q = Application.FileDialog(3)
 q.AllowMultiSelect = False
 q.Show
 Set excel = CreateObject("excel.Application")
 Set wb = excel.Workbooks.Open(q.SelectedItems(1))
 Set sht = wb.Worksheets("Manning for Quicklooks")
 lc = Sheets("Raw Data").Cells(88, Columns.Count).End(xlToLeft).Column
	If lc < 73 Then lc = 73
 sht.Activate
 sht.Range("C3:C51").Copy
 Sheets("Raw Data").Cells(88, lc + 1).PasteSpecial Paste:=xlPasteValues
 sht.Activate
 sht.Range("D3:D34").Copy
 Sheets("Raw Data").Cells(221, lc + 1).PasteSpecial Paste:=xlPasteValues
 sht.Activate
 sht.Range("E3:E34").Copy
 Sheets("Raw Data").Cells(337, lc + 1).PasteSpecial Paste:=xlPasteValues
 sht.Activate
 sht.Range("F3:F34").Copy
 Sheets("Raw Data").Cells(453, lc + 1).PasteSpecial Paste:=xlPasteValues
 Application.ScreenUpdating = True
 wb.Close
 End Sub

 

[moball45]

Awesome, it worked!! Thank you very much for your quick reply and help!

 

[JLGWhiz]

Awesome, it worked!! Thank you very much for your quick reply and help!

You're welcome,
Regards, JLG

 

[Moe Kadhom]

Hi
I was wondering if you can help me.

I have below VBA code that goes through multiple files and copy rang A1-C60 from all the sheets and paste them into a master workbook with one sheet. The macro is ran from that master workbook.

I need to run this macro every month, at the moment The data are pasted in the next available row. So my data are always in columns A to C with data running down.

I want the macro modified so the data are pasted in the next empty column. So the first time the macro is run, the data are pasted in columns A to C, the second time in D to F and so on........

could you help me?

Option Explicit


' >>>>> Put the initial path where the files to be processed are stored here. _
  End with backslash
Const sInitialPath = "C:\MyPath\"


Sub GetData()
    Dim wbIn As Workbook, wbOut As Workbook
    Dim rIn As Range, rOut As Range
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim diaFolder As FileDialog
    Dim lCount As Long


    Set wbOut = ThisWorkbook
    ' Assuming masterWB has only one sheet
    Set wsOut = wbOut.Sheets(1)
    
        '   get file name for file to process
    MsgBox "Select all the files you want to process by using the Ctrl key and the mouse. "

    ' Open the file dialog to get the  files
    Set diaFolder = Application.FileDialog(msoFileDialogFilePicker)
    With diaFolder
        .AllowMultiSelect = True
        .InitialView = msoFileDialogViewList
        .InitialFileName = sInitialPath
        lCount = .Show
    End With
    If lCount = -1 Then
    ' for each selected file
    For lCount = 1 To diaFolder.SelectedItems.Count
        
        Set wbIn = Workbooks.Open(diaFolder.SelectedItems(lCount))

        'loop through all the sheets in the opened book
        For Each wsIn In wbIn.Sheets
            'set output range on the Mastersheet to last row
            Set rOut = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Offset(1, 0)
            'now copy the values accross to the Mastersheet
            With wsIn.Range("A1:C60")
                rOut.Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
        Next wsIn
        'close WB
        wbIn.Close savechanges:=False
    Next lCount
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True

    'Cleanup
    Set wbIn = Nothing
    Set wbOut = Nothing
    Set rIn = Nothing
    Set rOut = Nothing
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set diaFolder = Nothing
End Sub

 

[AlphaFrog]

Hi
I was wondering if you can help me.

I have below VBA code that goes through multiple files and copy rang A1-C60 from all the sheets and paste them into a master workbook with one sheet. The macro is ran from that master workbook.

I need to run this macro every month, at the moment The data are pasted in the next available row. So my data are always in columns A to C with data running down.

I want the macro modified so the data are pasted in the next empty column. So the first time the macro is run, the data are pasted in columns A to C, the second time in D to F and so on........

could you help me?

Duplicates:

http://www.mrexcel.com/forum/excel-...paste-next-empty-cell-column.html#post4177977
http://www.mrexcel.com/forum/excel-...-paste-into-next-open-column.html#post4177976
http://www.mrexcel.com/forum/excel-...copy-paste-next-blank-column.html#post4177975
http://www.mrexcel.com/forum/excel-...-next-empty-cell-other-sheet.html#post4177972
http://www.mrexcel.com/forum/excel-questions/584509-pasting-next-blank-row-visual-basic-applications.html#post4177970


Forum Rules

21.) Avoid multiple questions of a similar nature. Duplicate posts by the same user will be locked and/or deleted when found.