Copy & Paste specific range from sheet 1 to sheet 2 using InputBox to stipulate the column letter?

[dougmarkham]

Hi Folks,

I wish to copy a defined range---G2:G12000 from sheet1 into D2:D12000 on sheet2. Sounds simple right? However, Sheet 1 arrives each day with an inconsistent column order: Column G (sheet1) is sometimes Column D, Column H or Column J etc. Problematically, the header name is not consistent either, preventing me from using that as an identifier. However, the row range in sheet1 I wish to copy is always the same (2:12000), also, the destination range is always the same (Sheet 2, range D2:D12000).


Is it possible via VBA to stipulate the column letter using an InputBox and have the VBA do the below copy/paste function?

Sub SelectCustPORefCol()' SelectCustRef Macro
    Worksheets("Sheet1").Activate
    Sheets("Sheet2").Range("D2:D12000").Value = Sheets("Sheet1").Range("G2:G12000").Value
    Sheets("Sheet2").Select
End Sub

I haven't been able to find an example similar to this online.
Please would you help me modify the copy/paste code or suggest a method to achieve this?

Kind regards,

Doug.

P.S.

I have already tried using this macro

Sub sample()
Dim rngToCopyFrom As Range, rngToPasteTo As Range
Set rngToCopyFrom = Application.InputBox("Selct first cell(s) to copy from", Type:=8)
If rngToCopyFrom Is Nothing Then Exit Sub
Set rngToCopyFrom = Rows(rngToCopyFrom.Row & ":" & ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row)
Set rngToPasteTo = Application.InputBox("Select first cell(s) to paste to", Type:=8)
If rngToPasteTo Is Nothing Then Exit Sub
rngToCopyFrom.Copy Rows(rngToPasteTo.Row).Cells(1, 1)
End Sub

However, there are lots of blank cells in my CopyFrom range. The macro runs but doesn't paste any data.

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim response As String
    response = InputBox("Please enter the column letter.")
    If response = "" Then
        MsgBox ("You have not entered a column letter.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    Sheets("Sheet1").Range(response & "2:" & response & 12000).Copy Sheets("Sheet2").Range("D2")
    Application.ScreenUpdating = True
End Sub

 

[dougmarkham]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim response As String
    response = InputBox("Please enter the column letter.")
   [B][COLOR=#0000cd] If response = "" Then[/COLOR][/B]
        MsgBox ("You have not entered a column letter.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    [B][COLOR=#0000cd]Sheets("Sheet1").Range(response & "2:" & response & 12000).Copy Sheets("Sheet2").Range("D2")[/COLOR][/B]
    Application.ScreenUpdating = True
End Sub

Hi Mumps,

Thanks for teaching me the above, that worked perfectly and I'll be able to use the response method in some other projects so you're a star!

Kind regards,

Doug.

 

[mumps]

You are very welcome.