VBA Kopiere Daten von einem Blatt in ein anderes

Question

Ich bin ziemlich neu in VBA und brauche Hilfe bei einem Projekt. Ich muss ein Makro schreiben, das den Blattname in Spalte C liest, und die Werte aus einer Quellarbeitsmappe in einen Bereich in einer Zielarbeitsmappe einfügen, der in Spalte D angegeben ist. So muss es beispielsweise kopiert werden die Daten in Sheet2 des MyWorkbook-Buchs und fügen Sie sie in den Bereich ihres Arbeitsblattes2 ein. Der Ort, an dem die Informationen zu Bereich und Blattnummer in einer separaten Arbeitsmappe gespeichert werden.

Edit: Ich habe ein Bild von dem, was wbOpen aussieht, hinzugefügt. This is it here.

Option Explicit 
 

 
Sub PasteToTargetRange() 
 

 
    Dim arrVar As Variant 'stores all the sheets to get the copied 
 
    Dim arrVarTarget As Variant 'stores names of sheets in target workbook 
 
    Dim rngRange As Range 'each sheet name in the given range 
 
    Dim rngLoop As Range 'Range that rngRange is based in 
 
    Dim wsSource As Worksheet 'source worksheet where ranges are found 
 
    Dim wbSource As Workbook 'workbook with the information to paste 
 
    Dim wbTarget As Workbook 'workbook that will receive information 
 
    Dim strSourceFile As String 'location of source workbook 
 
    Dim strTargetFile As String 'location of source workbook 
 
    Dim wbOpen As Workbook 'Current open workbook(one with inputs) 
 
    Dim wsRange As Range 'get information from source workbook 
 
    Dim varRange As Range 'Range where values should be pasted 
 
    Dim i As Integer 'counter for For Loop 
 
    Dim wbkNewSheet As Worksheet 'create new worksheet if target workbook doesn't have 
 
    Dim wsTarget As Worksheet 'target workbook worksheet 
 
    Dim varNumber As String 'range to post 
 
    
 
    
 
    
 
    Set wbOpen = Workbooks.Open("WorkbookWithRanges.xlsx") 
 
    
 
    'Open source file 
 
    MsgBox ("Open the source file") 
 
    strSourceFile = Application.GetOpenFilename 
 
     If strSourceFile = "" Then Exit Sub 
 
     Set wbSource = Workbooks.Open(strSourceFile) 
 
     
 
    'Open target file 
 
    MsgBox ("Open the target file") 
 
    strTargetFile = Application.GetOpenFilename 
 
     If strTargetFile = "" Then Exit Sub 
 
     Set wbTarget = Workbooks.Open(strTargetFile) 
 
    
 
    'Activate transfer Workbook 
 
    wbOpen.Activate 
 
    
 

 
    Set wsRange = ActiveSheet.Range("C9:C20") 
 
    
 
    Set arrVarTarget = wbTarget.Worksheets 
 
    
 
     
 
    For Each varRange In wsRange 
 
     If varRange.Value = 'Target workbook worksheets 
 
      varNumber = varRange.Offset(0, -1).Value 
 
      Set wsTarget = X.Offset(0, 1) 
 
      
 
      wsSouce.Range(wsTarget).Value = varNumber 
 
     Else 
 
      wbkNewSheet = Worksheets.Add 
 
      wbkNewSheet.Name = varRange.Value 
 
     End If 
 
    Next 
 
     
 
    
 
End Sub

Answer 1

Etwas Ähnliches (nicht getestet, aber sollte Ihnen eine Idee geben)

Sub PasteToTargetRange() 

    '....omitted 

    Set wsRange = wbOpen.Sheets(1).Range("C9:C20") 

    For Each c In wsRange 

     shtName = c.Offset(0, -1).Value 
     Set wsTarget = GetSheet(wbTarget, shtName) 'get the target sheet 

     wbSource.Sheets(shtName).Range(c.Value).Copy wsTarget.Range(c.Value) 

    Next 

End Sub 

'Get a reference to a named sheet in a specific workbook 
' By default will create the sheet if not found 
Function GetSheet(wb As Workbook, ws As String, Optional CreateIfMissing As Boolean = True) 
    Dim rv As Worksheet 
    On Error Resume Next 'ignore eroror if no match 
    Set rv = wb.Worksheets(ws) 
    On Error GoTo 0 'stop ignoring errors 
    'sheet wasn't found, and should create if missing 
    If rv Is Nothing And CreateIfMissing Then 
     Set rv = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count)) 
     rv.Name = ws 
    End If 
    Set GetSheet = rv 
End Function